{-# 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 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  aName <- Gen ApplicationName -> PropertyT IO ApplicationName
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen ApplicationName
genApplicationName
  assertIsRight $ checkApplicationName 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 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  (ApplicationName aName) <-
    Gen ApplicationName -> PropertyT IO ApplicationName
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      (Gen ApplicationName -> PropertyT IO ApplicationName)
-> Gen ApplicationName -> PropertyT IO ApplicationName
forall a b. (a -> b) -> a -> b
$ (ApplicationName -> Bool)
-> Gen ApplicationName -> Gen ApplicationName
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) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
forall i. Integral i => i
applicationNameMaxLength)
        Gen ApplicationName
genApplicationName
  moreText <- forAll $ Gen.text (Range.linear 1 20) Gen.ascii
  assertIsLeftConstr
    dummyAppNameTooLong
    (checkApplicationName . ApplicationName $ aName `T.append` 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 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  nonAscii <-
    Gen String -> PropertyT IO String
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      (Gen String -> PropertyT IO String)
-> Gen String -> PropertyT IO String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> Gen String -> Gen String
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter
        ((Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) ([Bool] -> Bool) -> (String -> [Bool]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Char -> Bool) -> String -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
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))
        (Range Int -> GenT Identity Char -> Gen String
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m String
Gen.string (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
forall i. Integral i => i
applicationNameMaxLength) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.unicodeAll)
  assertIsLeftConstr
    dummyAppNameNotAscii
    (checkApplicationName $ ApplicationName $ T.pack 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 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  sVer <- Gen SoftwareVersion -> PropertyT IO SoftwareVersion
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen SoftwareVersion
genSoftwareVersion
  assertIsRight $ checkSoftwareVersion 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 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  (ApplicationName aName) <-
    Gen ApplicationName -> PropertyT IO ApplicationName
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      (Gen ApplicationName -> PropertyT IO ApplicationName)
-> Gen ApplicationName -> PropertyT IO ApplicationName
forall a b. (a -> b) -> a -> b
$ (ApplicationName -> Bool)
-> Gen ApplicationName -> Gen ApplicationName
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) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
forall i. Integral i => i
applicationNameMaxLength)
        Gen ApplicationName
genApplicationName
  moreText <- forAll $ Gen.text (Range.linear 1 20) Gen.ascii
  let appNameTooLong = Text -> ApplicationName
ApplicationName (Text -> ApplicationName) -> Text -> ApplicationName
forall a b. (a -> b) -> a -> b
$ Text
aName Text -> Text -> Text
`T.append` Text
moreText
  sVersion <- forAll genSoftwareVersion
  let sVersion' = SoftwareVersion
sVersion {svAppName = appNameTooLong}
  assertIsLeftConstr dummySoftVerTooLong (checkSoftwareVersion 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 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  nonAscii <-
    Gen String -> PropertyT IO String
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      (Gen String -> PropertyT IO String)
-> Gen String -> PropertyT IO String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> Gen String -> Gen String
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter
        ((Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) ([Bool] -> Bool) -> (String -> [Bool]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Char -> Bool) -> String -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
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))
        (Range Int -> GenT Identity Char -> Gen String
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m String
Gen.string (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
forall i. Integral i => i
applicationNameMaxLength) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.unicodeAll)
  let appNameNonascii = Text -> ApplicationName
ApplicationName (Text -> ApplicationName) -> Text -> ApplicationName
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
nonAscii
  sVersion <- forAll genSoftwareVersion
  let sVersion' = SoftwareVersion
sVersion {svAppName = appNameNonascii}
  assertIsLeftConstr dummySoftVerNotAscii (checkSoftwareVersion 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 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  sTag <- Gen SystemTag -> PropertyT IO SystemTag
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen SystemTag
genSystemTag
  assertIsRight $ checkSystemTag 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 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  (SystemTag tag) <-
    Gen SystemTag -> PropertyT IO SystemTag
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      (Gen SystemTag -> PropertyT IO SystemTag)
-> Gen SystemTag -> PropertyT IO SystemTag
forall a b. (a -> b) -> a -> b
$ (SystemTag -> Bool) -> Gen SystemTag -> Gen SystemTag
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) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
forall i. Integral i => i
systemTagMaxLength)
        Gen SystemTag
genSystemTag
  moreText <- forAll $ Gen.text (Range.linear 1 20) Gen.ascii
  let sysTagTooLong = Text -> SystemTag
SystemTag (Text
tag Text -> Text -> Text
`T.append` Text
moreText)
  assertIsLeftConstr dummySysTagTooLong (checkSystemTag 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 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  nonAscii <-
    Gen String -> PropertyT IO String
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      (Gen String -> PropertyT IO String)
-> Gen String -> PropertyT IO String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> Gen String -> Gen String
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter
        ((Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) ([Bool] -> Bool) -> (String -> [Bool]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Char -> Bool) -> String -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
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))
        (Range Int -> GenT Identity Char -> Gen String
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m String
Gen.string (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
forall i. Integral i => i
systemTagMaxLength) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.unicodeAll)
  let sysTagNonascii = Text -> SystemTag
SystemTag (Text -> SystemTag) -> Text -> SystemTag
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
nonAscii
  assertIsLeftConstr dummySysTagNotAscii (checkSystemTag sysTagNonascii)

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

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

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

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

dummySoftVerNotAscii :: Constr
dummySoftVerNotAscii :: Constr
dummySoftVerNotAscii =
  SoftwareVersionError -> Constr
forall a. Data a => a -> Constr
toConstr
    (SoftwareVersionError -> Constr)
-> (ApplicationNameError -> SoftwareVersionError)
-> ApplicationNameError
-> Constr
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
    (ApplicationNameError -> Constr) -> ApplicationNameError -> Constr
forall a b. (a -> b) -> a -> b
$ Text -> ApplicationNameError
ApplicationNameNotAscii
      Text
"dummyValue"

dummySoftVerTooLong :: Constr
dummySoftVerTooLong :: Constr
dummySoftVerTooLong =
  SoftwareVersionError -> Constr
forall a. Data a => a -> Constr
toConstr
    (SoftwareVersionError -> Constr)
-> (ApplicationNameError -> SoftwareVersionError)
-> ApplicationNameError
-> Constr
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
    (ApplicationNameError -> Constr) -> ApplicationNameError -> Constr
forall a b. (a -> b) -> a -> b
$ Text -> ApplicationNameError
ApplicationNameTooLong
      Text
"dummyValue"

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

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