core: improve mkStorePathName and its errors, add test

This commit is contained in:
sorki 2023-12-05 07:38:35 +01:00
parent 9cf2e1aa34
commit 70443c884b
3 changed files with 57 additions and 21 deletions

View File

@ -102,6 +102,7 @@ test-suite core
Fingerprint
Hash
Signature
StorePath
hs-source-dirs:
tests
build-tool-depends:

View File

@ -20,7 +20,6 @@ module System.Nix.StorePath
-- * Manipulating 'StorePathName'
, InvalidNameError(..)
, mkStorePathName
, validStorePathName
-- * Reason why a path is not valid
, InvalidPathError(..)
, -- * Rendering out 'StorePath's
@ -119,9 +118,9 @@ mkStorePathHashPart =
-- | Reason why a path name or output name is not valid
data InvalidNameError
= EmptyName
| NameTooLong
| NameTooLong Int
| LeadingDot
| InvalidCharacter
| InvalidCharacters Text
deriving (Eq, Generic, Hashable, Ord, Show)
-- | Reason why a path is not valid
@ -137,24 +136,22 @@ data InvalidPathError
-- | Make @StorePathName@ from @Text@ (name part of the @StorePath@)
-- or fail with @InvalidNameError@ if it isn't valid
mkStorePathName :: Text -> Either InvalidNameError StorePathName
mkStorePathName n =
if validStorePathName n
then pure $ StorePathName n
else Left $ reasonInvalid n
reasonInvalid :: Text -> InvalidNameError
reasonInvalid n
| n == "" = EmptyName
| Data.Text.length n > 211 = NameTooLong
| Data.Text.head n == '.' = LeadingDot
| otherwise = InvalidCharacter
validStorePathName :: Text -> Bool
validStorePathName n =
n /= ""
&& Data.Text.length n <= 211
&& Data.Text.head n /= '.'
&& Data.Text.all validStorePathNameChar n
mkStorePathName n
| n == ""
= Left EmptyName
| Data.Text.length n > 211
= Left $ NameTooLong (Data.Text.length n)
| Data.Text.head n == '.'
= Left $ LeadingDot
| not
$ Data.Text.null
$ Data.Text.filter
(not . validStorePathNameChar)
n
= Left
$ InvalidCharacters
$ Data.Text.filter (not . validStorePathNameChar) n
| otherwise = pure $ StorePathName n
validStorePathNameChar :: Char -> Bool
validStorePathNameChar c =

View File

@ -0,0 +1,38 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module StorePath where
import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
import qualified Data.Either
import qualified Data.Text
import System.Nix.StorePath (mkStorePathName)
spec_storePath :: Spec
spec_storePath = do
describe "StorePathName" $ do
it "parses valid name" $
mkStorePathName "name-dev.dotok"
`shouldSatisfy`
Data.Either.isRight
it "fails on empty" $
mkStorePathName mempty
`shouldBe`
Left EmptyName
it "fails on too long" $
mkStorePathName (Data.Text.replicate 256 "n")
`shouldBe`
Left (NameTooLong 256)
it "fails on leading dot" $
mkStorePathName ".ab"
`shouldBe`
Left LeadingDot
it "fails on invalid characters" $
mkStorePathName "ab!cd#@"
`shouldBe`
Left (InvalidCharacters "!#@")