mirror of
https://github.com/sol/hpack.git
synced 2024-10-04 03:38:00 +03:00
Reject URLs for github
This commit is contained in:
parent
19a07bf8fc
commit
f63eb19b95
@ -1,5 +1,6 @@
|
||||
## Changes in 0.34.0 (upcoming)
|
||||
- Add support for library `visibility` (see #382)
|
||||
- Reject URLs for `github`
|
||||
|
||||
## Changes in 0.33.0
|
||||
- Support GHC 8.8.1: `fail` is no longer a part of `Monad`. Instead, it lives
|
||||
|
@ -534,7 +534,7 @@ data PackageConfig_ library executable = PackageConfig {
|
||||
, packageConfigExtraDocFiles :: Maybe (List FilePath)
|
||||
, packageConfigDataFiles :: Maybe (List FilePath)
|
||||
, packageConfigDataDir :: Maybe FilePath
|
||||
, packageConfigGithub :: Maybe Text
|
||||
, packageConfigGithub :: Maybe GitHub
|
||||
, packageConfigGit :: Maybe String
|
||||
, packageConfigCustomSetup :: Maybe CustomSetupSection
|
||||
, packageConfigLibrary :: Maybe library
|
||||
@ -545,6 +545,20 @@ data PackageConfig_ library executable = PackageConfig {
|
||||
, packageConfigBenchmarks :: Maybe (Map String executable)
|
||||
} deriving Generic
|
||||
|
||||
data GitHub = GitHub {
|
||||
_gitHubOwner :: String
|
||||
, _gitHubRepo :: String
|
||||
, _gitHubSubdir :: Maybe String
|
||||
}
|
||||
|
||||
instance FromValue GitHub where
|
||||
fromValue v = do
|
||||
input <- fromValue v
|
||||
case map T.unpack $ T.splitOn "/" input of
|
||||
[owner, repo, subdir] -> return $ GitHub owner repo (Just subdir)
|
||||
[owner, repo] -> return $ GitHub owner repo Nothing
|
||||
_ -> fail $ "expected owner/repo or owner/repo/subdir, but encountered " ++ show input
|
||||
|
||||
data DefaultsConfig = DefaultsConfig {
|
||||
defaultsConfigDefaults :: Maybe (List Defaults)
|
||||
} deriving (Generic, FromValue)
|
||||
@ -1149,13 +1163,10 @@ toPackage_ dir (Product g PackageConfig{..}) = do
|
||||
sourceRepository = github <|> (`SourceRepository` Nothing) <$> packageConfigGit
|
||||
|
||||
github :: Maybe SourceRepository
|
||||
github = parseGithub <$> packageConfigGithub
|
||||
github = toSourceRepository <$> packageConfigGithub
|
||||
where
|
||||
parseGithub :: Text -> SourceRepository
|
||||
parseGithub input = case map T.unpack $ T.splitOn "/" input of
|
||||
[owner, repo, subdir] ->
|
||||
SourceRepository (githubBaseUrl ++ owner ++ "/" ++ repo) (Just subdir)
|
||||
_ -> SourceRepository (githubBaseUrl ++ T.unpack input) Nothing
|
||||
toSourceRepository :: GitHub -> SourceRepository
|
||||
toSourceRepository (GitHub repo owner subdir) = SourceRepository (githubBaseUrl ++ owner ++ "/" ++ repo) subdir
|
||||
|
||||
homepage :: Maybe String
|
||||
homepage = case packageConfigHomepage of
|
||||
|
@ -132,6 +132,11 @@ spec = around_ (inTempDirectoryNamed "foo") $ do
|
||||
subdir: hspec-core
|
||||
|]
|
||||
|
||||
it "rejects URLs" $ do
|
||||
[i|
|
||||
github: https://github.com/sol/hpack/issues/365
|
||||
|] `shouldFailWith` "package.yaml: Error while parsing $.github - expected owner/repo or owner/repo/subdir, but encountered \"https://github.com/sol/hpack/issues/365\""
|
||||
|
||||
describe "homepage" $ do
|
||||
it "accepts homepage URL" $ do
|
||||
[i|
|
||||
|
Loading…
Reference in New Issue
Block a user