Cabal-tests/tests/UnitTests/Distribution/SPDX.hs

   1 {-# OPTIONS_GHC -fno-warn-deprecations #-}
   2 module UnitTests.Distribution.SPDX (spdxTests) where
   3
   4 import Distribution.Compat.Prelude.Internal
   5 import Prelude ()
   6
   7 import Distribution.SPDX
   8 import Distribution.Parsec (eitherParsec)
   9 import Distribution.Pretty (prettyShow)
  10
  11 import Test.Tasty
  12 import Test.Tasty.QuickCheck
  13
  14 import Test.QuickCheck.Instances.Cabal ()
  15
  16 spdxTests :: [TestTree]
  17 spdxTests =
  18     [ testProperty "LicenseId roundtrip" licenseIdRoundtrip
  19     , testProperty "LicenseExceptionId roundtrip" licenseExceptionIdRoundtrip
  20     , testProperty "LicenseRef roundtrip" licenseRefRoundtrip
  21     , testProperty "SimpleLicenseExpression roundtrip" simpleLicenseExpressionRoundtrip
  22     , testProperty "LicenseExpression roundtrip" licenseExpressionRoundtrip
  23     , testProperty "isAcceptableLicense l = True"  shouldAcceptProp
  24     , testProperty "isAcceptableLicense l = False" shouldRejectProp
  25     ]
  26
  27 licenseIdRoundtrip :: LicenseId -> Property
  28 licenseIdRoundtrip x =
  29     counterexample (prettyShow x) $
  30     Right x === eitherParsec (prettyShow x)
  31
  32 licenseExceptionIdRoundtrip :: LicenseExceptionId -> Property
  33 licenseExceptionIdRoundtrip x =
  34     counterexample (prettyShow x) $
  35     Right x === eitherParsec (prettyShow x)
  36
  37 licenseRefRoundtrip :: LicenseRef -> Property
  38 licenseRefRoundtrip x =
  39     counterexample (prettyShow x) $
  40     Right x === eitherParsec (prettyShow x)
  41
  42 simpleLicenseExpressionRoundtrip :: SimpleLicenseExpression -> Property
  43 simpleLicenseExpressionRoundtrip x =
  44     counterexample (prettyShow x) $
  45     Right x === eitherParsec (prettyShow x)
  46
  47 licenseExpressionRoundtrip :: LicenseExpression -> Property
  48 licenseExpressionRoundtrip x =
  49     counterexample (prettyShow x) $
  50     Right (reassoc x) === eitherParsec (prettyShow x)
  51
  52 -- Parser produces right biased trees of and/or expressions
  53 reassoc :: LicenseExpression -> LicenseExpression
  54 reassoc (EOr a b) = case reassoc a of
  55     EOr x y -> EOr x (reassoc (EOr y b))
  56     x       -> EOr x (reassoc b)
  57 reassoc (EAnd a b) = case reassoc a of
  58     EAnd x y -> EAnd x (reassoc (EAnd y b))
  59     x       -> EAnd x (reassoc b)
  60 reassoc l = l
  61
  62 -------------------------------------------------------------------------------
  63 -- isAcceptableLicence
  64 -------------------------------------------------------------------------------
  65
  66 shouldAccept :: [License]
  67 shouldAccept = map License
  68     [ simpleLicenseExpression GPL_2_0_only
  69     , simpleLicenseExpression GPL_2_0_or_later
  70     , simpleLicenseExpression BSD_2_Clause
  71     , simpleLicenseExpression BSD_3_Clause
  72     , simpleLicenseExpression MIT
  73     , simpleLicenseExpression ISC
  74     , simpleLicenseExpression MPL_2_0
  75     , simpleLicenseExpression Apache_2_0
  76     , simpleLicenseExpression CC0_1_0
  77     , simpleLicenseExpression BSD_4_Clause `EOr` simpleLicenseExpression MIT
  78     ]
  79
  80 shouldReject :: [License]
  81 shouldReject = map License
  82     [ simpleLicenseExpression BSD_4_Clause
  83     , simpleLicenseExpression BSD_4_Clause `EAnd` simpleLicenseExpression MIT
  84     ]
  85
  86 -- | A sketch of what Hackage could accept
  87 --
  88 -- * NONE is rejected
  89 --
  90 -- * "or later" syntax (+ postfix) is rejected
  91 --
  92 -- * "WITH exc" exceptions are rejected
  93 --
  94 -- * There should be a way to interpret license as (conjunction of)
  95 --   OSI-accepted licenses or CC0
  96 --
  97 isAcceptableLicense :: License -> Bool
  98 isAcceptableLicense NONE           = False
  99 isAcceptableLicense (License expr) = goExpr expr
 100   where
 101     goExpr (EAnd a b)            = goExpr a && goExpr b
 102     goExpr (EOr a b)             = goExpr a || goExpr b
 103     goExpr (ELicense _ (Just _)) = False -- Don't allow exceptions
 104     goExpr (ELicense s Nothing)  = goSimple s
 105
 106     goSimple (ELicenseRef _)      = False -- don't allow referenced licenses
 107     goSimple (ELicenseIdPlus _)   = False -- don't allow + licenses (use GPL-3.0-or-later e.g.)
 108     goSimple (ELicenseId CC0_1_0) = True -- CC0 isn't OSI approved, but we allow it as "PublicDomain", this is eg. PublicDomain in http://hackage.haskell.org/package/string-qq-0.0.2/src/LICENSE
 109     goSimple (ELicenseId lid)     = licenseIsOsiApproved lid -- allow only OSI approved licenses.
 110
 111 shouldAcceptProp :: Property
 112 shouldAcceptProp = conjoin $
 113     map (\l -> counterexample (prettyShow l) (isAcceptableLicense l)) shouldAccept
 114
 115 shouldRejectProp :: Property
 116 shouldRejectProp = conjoin $
 117     map (\l -> counterexample (prettyShow l) (not $ isAcceptableLicense l)) shouldReject