{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Test.Cardano.Chain.Update.Properties (
  tests,
)
where

import Cardano.Chain.Update (
  ApplicationName (..),
  ApplicationNameError (..),
  SoftwareVersion (..),
  SoftwareVersionError (..),
  SystemTag (..),
  SystemTagError (..),
  applicationNameMaxLength,
  checkApplicationName,
  checkSoftwareVersion,
  checkSystemTag,
  systemTagMaxLength,
 )
import Cardano.Prelude
import Data.Data (Constr, toConstr)
import qualified Data.Text as T
import Hedgehog (forAll, property)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Cardano.Chain.Update.Gen (
  genApplicationName,
  genSoftwareVersion,
  genSystemTag,
 )
import Test.Cardano.Prelude
import Test.Options (TSGroup, TSProperty, withTestsTS)

-- Make sure `checkApplicationName` works for allowed values.
ts_prop_checkApplicationName :: TSProperty
ts_prop_checkApplicationName :: TSProperty
ts_prop_checkApplicationName = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  ApplicationName
aName <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen ApplicationName
genApplicationName
  forall a (m :: * -> *) b.
(Buildable a, HasCallStack, MonadTest m) =>
Either a b -> m ()
assertIsRight forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadError ApplicationNameError m =>
ApplicationName -> m ()
checkApplicationName ApplicationName
aName

-- Make sure `checkApplicationName` fails on names that are too long.
ts_prop_checkApplicationNameTooLong :: TSProperty
ts_prop_checkApplicationNameTooLong :: TSProperty
ts_prop_checkApplicationNameTooLong = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  (ApplicationName Text
aName) <-
    forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter
        (\ApplicationName
name -> Text -> Int
T.length (ApplicationName -> Text
unApplicationName ApplicationName
name) forall a. Ord a => a -> a -> Bool
>= forall i. Integral i => i
applicationNameMaxLength)
        Gen ApplicationName
genApplicationName
  Text
moreText <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
20) forall (m :: * -> *). MonadGen m => m Char
Gen.ascii
  forall b a (m :: * -> *).
(Buildable b, Data a, HasCallStack, MonadTest m) =>
Constr -> Either a b -> m ()
assertIsLeftConstr
    Constr
dummyAppNameTooLong
    (forall (m :: * -> *).
MonadError ApplicationNameError m =>
ApplicationName -> m ()
checkApplicationName forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ApplicationName
ApplicationName forall a b. (a -> b) -> a -> b
$ Text
aName Text -> Text -> Text
`T.append` Text
moreText)

-- Make sure `checkApplicationName` fails on names that are non-ascii.
ts_prop_checkApplicationNameNotAscii :: TSProperty
ts_prop_checkApplicationNameNotAscii :: TSProperty
ts_prop_checkApplicationNameNotAscii = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  String
nonAscii <-
    forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter
        (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Bool
True) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Bool
isAscii))
        (forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m String
Gen.string (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 forall i. Integral i => i
applicationNameMaxLength) forall (m :: * -> *). MonadGen m => m Char
Gen.unicodeAll)
  forall b a (m :: * -> *).
(Buildable b, Data a, HasCallStack, MonadTest m) =>
Constr -> Either a b -> m ()
assertIsLeftConstr
    Constr
dummyAppNameNotAscii
    (forall (m :: * -> *).
MonadError ApplicationNameError m =>
ApplicationName -> m ()
checkApplicationName forall a b. (a -> b) -> a -> b
$ Text -> ApplicationName
ApplicationName forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
nonAscii)

-- Make sure `checkSoftwareVersion` works for allowed values.
ts_prop_checkSoftwareVersion :: TSProperty
ts_prop_checkSoftwareVersion :: TSProperty
ts_prop_checkSoftwareVersion = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  SoftwareVersion
sVer <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen SoftwareVersion
genSoftwareVersion
  forall a (m :: * -> *) b.
(Buildable a, HasCallStack, MonadTest m) =>
Either a b -> m ()
assertIsRight forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadError SoftwareVersionError m =>
SoftwareVersion -> m ()
checkSoftwareVersion SoftwareVersion
sVer

-- Make sure `checkSoftwareVersion` fails on names that are too long.
ts_prop_checkSoftwareVersionTooLong :: TSProperty
ts_prop_checkSoftwareVersionTooLong :: TSProperty
ts_prop_checkSoftwareVersionTooLong = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  (ApplicationName Text
aName) <-
    forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter
        (\ApplicationName
name -> Text -> Int
T.length (ApplicationName -> Text
unApplicationName ApplicationName
name) forall a. Ord a => a -> a -> Bool
>= forall i. Integral i => i
applicationNameMaxLength)
        Gen ApplicationName
genApplicationName
  Text
moreText <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
20) forall (m :: * -> *). MonadGen m => m Char
Gen.ascii
  let appNameTooLong :: ApplicationName
appNameTooLong = Text -> ApplicationName
ApplicationName forall a b. (a -> b) -> a -> b
$ Text
aName Text -> Text -> Text
`T.append` Text
moreText
  SoftwareVersion
sVersion <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen SoftwareVersion
genSoftwareVersion
  let sVersion' :: SoftwareVersion
sVersion' = SoftwareVersion
sVersion {svAppName :: ApplicationName
svAppName = ApplicationName
appNameTooLong}
  forall b a (m :: * -> *).
(Buildable b, Data a, HasCallStack, MonadTest m) =>
Constr -> Either a b -> m ()
assertIsLeftConstr Constr
dummySoftVerTooLong (forall (m :: * -> *).
MonadError SoftwareVersionError m =>
SoftwareVersion -> m ()
checkSoftwareVersion SoftwareVersion
sVersion')

-- Make sure `checkSoftwareVersion` fails on names that are non-ascii.
ts_prop_checkSoftwareVersionNotAscii :: TSProperty
ts_prop_checkSoftwareVersionNotAscii :: TSProperty
ts_prop_checkSoftwareVersionNotAscii = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  String
nonAscii <-
    forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter
        (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Bool
True) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Bool
isAscii))
        (forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m String
Gen.string (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 forall i. Integral i => i
applicationNameMaxLength) forall (m :: * -> *). MonadGen m => m Char
Gen.unicodeAll)
  let appNameNonascii :: ApplicationName
appNameNonascii = Text -> ApplicationName
ApplicationName forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
nonAscii
  SoftwareVersion
sVersion <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen SoftwareVersion
genSoftwareVersion
  let sVersion' :: SoftwareVersion
sVersion' = SoftwareVersion
sVersion {svAppName :: ApplicationName
svAppName = ApplicationName
appNameNonascii}
  forall b a (m :: * -> *).
(Buildable b, Data a, HasCallStack, MonadTest m) =>
Constr -> Either a b -> m ()
assertIsLeftConstr Constr
dummySoftVerNotAscii (forall (m :: * -> *).
MonadError SoftwareVersionError m =>
SoftwareVersion -> m ()
checkSoftwareVersion SoftwareVersion
sVersion')

-- Make sure `checkSystemTag` works for allowed values.
ts_prop_checkSystemTag :: TSProperty
ts_prop_checkSystemTag :: TSProperty
ts_prop_checkSystemTag = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  SystemTag
sTag <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen SystemTag
genSystemTag
  forall a (m :: * -> *) b.
(Buildable a, HasCallStack, MonadTest m) =>
Either a b -> m ()
assertIsRight forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadError SystemTagError m =>
SystemTag -> m ()
checkSystemTag SystemTag
sTag

-- Make sure `checkSystemTag` fails on tags that are too long.
ts_prop_checkSystemTagTooLong :: TSProperty
ts_prop_checkSystemTagTooLong :: TSProperty
ts_prop_checkSystemTagTooLong = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  (SystemTag Text
tag) <-
    forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter
        (\SystemTag
sysTag -> Text -> Int
T.length (SystemTag -> Text
getSystemTag SystemTag
sysTag) forall a. Ord a => a -> a -> Bool
>= forall i. Integral i => i
systemTagMaxLength)
        Gen SystemTag
genSystemTag
  Text
moreText <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
20) forall (m :: * -> *). MonadGen m => m Char
Gen.ascii
  let sysTagTooLong :: SystemTag
sysTagTooLong = Text -> SystemTag
SystemTag (Text
tag Text -> Text -> Text
`T.append` Text
moreText)
  forall b a (m :: * -> *).
(Buildable b, Data a, HasCallStack, MonadTest m) =>
Constr -> Either a b -> m ()
assertIsLeftConstr Constr
dummySysTagTooLong (forall (m :: * -> *).
MonadError SystemTagError m =>
SystemTag -> m ()
checkSystemTag SystemTag
sysTagTooLong)

-- Make sure `checkSystemTag` fails on names that are non-ascii.
ts_prop_checkSystemTagNotAscii :: TSProperty
ts_prop_checkSystemTagNotAscii :: TSProperty
ts_prop_checkSystemTagNotAscii = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  String
nonAscii <-
    forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter
        (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Bool
True) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Bool
isAscii))
        (forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m String
Gen.string (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 forall i. Integral i => i
systemTagMaxLength) forall (m :: * -> *). MonadGen m => m Char
Gen.unicodeAll)
  let sysTagNonascii :: SystemTag
sysTagNonascii = Text -> SystemTag
SystemTag forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
nonAscii
  forall b a (m :: * -> *).
(Buildable b, Data a, HasCallStack, MonadTest m) =>
Constr -> Either a b -> m ()
assertIsLeftConstr Constr
dummySysTagNotAscii (forall (m :: * -> *).
MonadError SystemTagError m =>
SystemTag -> m ()
checkSystemTag SystemTag
sysTagNonascii)

tests :: TSGroup
tests :: TSGroup
tests = $$discoverPropArg

--------------------------------------------------------------------------------
-- Dummy values for constructor comparison in assertIsLeftConstr tests
--------------------------------------------------------------------------------

dummyAppNameNotAscii :: Constr
dummyAppNameNotAscii :: Constr
dummyAppNameNotAscii = forall a. Data a => a -> Constr
toConstr forall a b. (a -> b) -> a -> b
$ Text -> ApplicationNameError
ApplicationNameNotAscii Text
"dummyValue"

dummyAppNameTooLong :: Constr
dummyAppNameTooLong :: Constr
dummyAppNameTooLong = forall a. Data a => a -> Constr
toConstr forall a b. (a -> b) -> a -> b
$ Text -> ApplicationNameError
ApplicationNameTooLong Text
"dummyValue"

dummySoftVerNotAscii :: Constr
dummySoftVerNotAscii :: Constr
dummySoftVerNotAscii =
  forall a. Data a => a -> Constr
toConstr
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ApplicationNameError -> SoftwareVersionError
SoftwareVersionApplicationNameError
    forall a b. (a -> b) -> a -> b
$ Text -> ApplicationNameError
ApplicationNameNotAscii
      Text
"dummyValue"

dummySoftVerTooLong :: Constr
dummySoftVerTooLong :: Constr
dummySoftVerTooLong =
  forall a. Data a => a -> Constr
toConstr
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ApplicationNameError -> SoftwareVersionError
SoftwareVersionApplicationNameError
    forall a b. (a -> b) -> a -> b
$ Text -> ApplicationNameError
ApplicationNameTooLong
      Text
"dummyValue"

dummySysTagNotAscii :: Constr
dummySysTagNotAscii :: Constr
dummySysTagNotAscii = forall a. Data a => a -> Constr
toConstr forall a b. (a -> b) -> a -> b
$ Text -> SystemTagError
SystemTagNotAscii Text
"dummyValue"

dummySysTagTooLong :: Constr
dummySysTagTooLong :: Constr
dummySysTagTooLong = forall a. Data a => a -> Constr
toConstr forall a b. (a -> b) -> a -> b
$ Text -> SystemTagError
SystemTagTooLong Text
"dummyValue"