RefName.hs

{-# LANGUAGE OverloadedStrings #-}

{-|

Description: Safe reference and remote names.

Git constrains the names of references (branches, tags, etc.) to a collection of 10-or-so rules (see
@git help check-ref-format@ for details).  This module provides checked wrappers for refnames and
remote names.

-}
module Data.Git.RefName
    (
    -- * Reference Names
    RefName
    , getRefName
    , refName
    , checkRefFormat

    -- * Remote Names
    , RemoteName
    , getRemoteName
    , remoteName
    , checkRemoteName
    ) where

import qualified Data.ByteString as B
import           Data.String
import           System.Posix.FilePath

-- | Safe reference names.  Construct with 'refName'.
newtype RefName = RefName
    {
      getRefName :: RawFilePath -- ^ The 'RefName's underlying 'RawFilePath'
    } deriving (Eq, Ord, Show)

instance IsString RefName where
    fromString rn = maybe (error $ "invalid refname: " ++ rn)
                          id
                          (refName . fromString $ rn)

-- | Try to make a 'RefName', given that 'checkRefFormat' allows it.
refName :: RawFilePath -> Maybe RefName
refName name | checkRefFormat True False name = Just (RefName name)
             | otherwise                      = Nothing

-- | Check a potential refname against the rules for well formed refnames according to @git help
--   check-ref-format@
checkRefFormat :: Bool -- ^ Allow refnames with no @/@s, as @--allow-onelevel@
               -> Bool -- ^ Allow one and only one asterisk in a ref, as @--refspec-pattern@
               -> RawFilePath
               -> Bool
checkRefFormat allowOneLevel refSpecPattern name =
    not (B.null name)
    && not (any (\c -> "." `B.isPrefixOf` c   --  1. They can include slash / for hierarchical
              || ".lock" `B.isSuffixOf` c) --  (directory) grouping, but no slash-separated component
             (splitDirectories name))     --  can begin with a dot .  or end with the sequence
                                          --  .lock.

    && (allowOneLevel                  --  2. They must contain at least one /. This enforces the
       || ("/" `B.isInfixOf` name))    --  presence of a category like heads/, tags/ etc. but the
                                      --  actual names are not restricted.  If the --allow-onelevel
                                      --  option is used, this rule is waived.

    && not (".." `B.isInfixOf` name)     --  3. They cannot have two consecutive dots ..  anywhere.

    && not (B.any (\c -> c < 040          --  4. They cannot have ASCII control characters (i.e. bytes
                ||    c == 0o177        --  whose values are lower than \040, or \177 DEL), space,
                || c `B.elem` " \t\n\r\f\v~^:") name) --  tilde ~, caret ^, or colon : anywhere.

    && not (B.any (`B.elem` "?[") name   --  5. They cannot have question-mark ?, asterisk *, or open
         || (refSpecPattern            --  bracket [ anywhere. See the --refspec-pattern option
            && B.count 0o52 name > 1)  --  below for an exception to this rule. (0o52 == '*')
         || (not refSpecPattern
            && 0o52 `B.elem` name))

    && not ("/" `B.isSuffixOf` name      --  6. They cannot begin or end with a slash / or contain
         || "/" `B.isPrefixOf` name    --  multiple consecutive slashes (see the --normalize option
         || "//" `B.isInfixOf` name)   --  below for an exception to this rule)

    && not ("." `B.isSuffixOf` name)     --  7. They cannot end with a dot ..

    && not ("@{" `B.isInfixOf` name)     --  8. They cannot contain a sequence @{.

    && "@" /= name                      --  9. They cannot be the single character @.

    && not ("\\" `B.isInfixOf` name)     -- 10. They cannot contain a \.

-- | Safe remote names.  Construct with 'remoteName'.
newtype RemoteName = RemoteName
    {
      getRemoteName :: B.ByteString -- ^ The 'RemoteName's underlying 'RawFilePath'
    } deriving (Eq, Ord, Show)

instance IsString RemoteName where
    fromString rn = maybe (error $ "invalid remote name: " ++ rn)
                          id
                          (remoteName . fromString $ rn)

-- | Ensure the name is contains no @/@, and is none of: @""@, @"."@, per
--   https://github.com/git/git/blob/1f66975deb8402131fbf7c14330d0c7cdebaeaa2/remote.c#L644.
checkRemoteName :: B.ByteString -> Bool
checkRemoteName b = b /= "" && b /= "." && b /= ".." && B.notElem 0o57 b

-- | Try to make a 'RemoteName', ensuring it's valid according to 'checkRemoteName'.
remoteName :: RawFilePath -> Maybe RemoteName
remoteName name | checkRemoteName name = Just (RemoteName name)
                | otherwise            = Nothing