module Hydra.API.ServerOutputSpec where

import Hydra.Prelude
import Test.Hydra.Prelude

import Control.Lens (toListOf, (^.))
import Data.Aeson.Lens (key, values, _Array)
import Hydra.API.ServerOutput (ClientMessage, Greetings (..), ServerOutput, TimedServerOutput)
import Hydra.Chain.Direct.State ()
import Hydra.JSONSchema (prop_specIsComplete, prop_validateJSONSchema)
import Hydra.Ledger.Cardano (Tx)
import Hydra.Utils (readJsonFileThrow)
import Test.Aeson.GenericSpecs (
  Settings (..),
  defaultSettings,
  roundtripAndGoldenADTSpecsWithSettings,
 )
import Test.QuickCheck (conjoin, withMaxSuccess)

spec :: Spec
spec :: Spec
spec = Spec -> Spec
forall a. SpecWith a -> SpecWith a
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  Settings -> Proxy (MinimumSized (ServerOutput Tx)) -> Spec
forall a.
(Arbitrary a, ToADTArbitrary a, Eq a, Show a, ToJSON a,
 FromJSON a) =>
Settings -> Proxy a -> Spec
roundtripAndGoldenADTSpecsWithSettings Settings
defaultSettings{sampleSize = 1} (Proxy (MinimumSized (ServerOutput Tx)) -> Spec)
-> Proxy (MinimumSized (ServerOutput Tx)) -> Spec
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(MinimumSized (ServerOutput Tx))

  -- NOTE: Kupo and maybe other downstream projects use this file as a test vector.
  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"golden SnapshotConfirmed is good" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    let goldenFile :: String
goldenFile = String
"golden/ServerOutput/SnapshotConfirmed.json"
    [Value]
samples <- (Value -> Parser Value) -> String -> IO Value
forall a. (Value -> Parser a) -> String -> IO a
readJsonFileThrow Value -> Parser Value
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
goldenFile IO Value -> (Value -> [Value]) -> IO [Value]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Getting (Endo [Value]) Value Value -> Value -> [Value]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"samples" Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Value]) Value Value
forall t. AsValue t => IndexedTraversal' Int t Value
IndexedTraversal' Int Value Value
values)
    let isGood :: s -> Bool
isGood s
s =
          Bool -> Bool
not (Bool -> Bool) -> (Vector Value -> Bool) -> Vector Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Value -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Vector Value -> Bool) -> Vector Value -> Bool
forall a b. (a -> b) -> a -> b
$ s
s s -> Getting (Vector Value) s (Vector Value) -> Vector Value
forall s a. s -> Getting a s a -> a
^. Key -> Traversal' s Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshot" ((Value -> Const (Vector Value) Value)
 -> s -> Const (Vector Value) s)
-> ((Vector Value -> Const (Vector Value) (Vector Value))
    -> Value -> Const (Vector Value) Value)
-> Getting (Vector Value) s (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"confirmed" ((Value -> Const (Vector Value) Value)
 -> Value -> Const (Vector Value) Value)
-> ((Vector Value -> Const (Vector Value) (Vector Value))
    -> Value -> Const (Vector Value) Value)
-> (Vector Value -> Const (Vector Value) (Vector Value))
-> Value
-> Const (Vector Value) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (Vector Value) (Vector Value))
-> Value -> Const (Vector Value) Value
forall t. AsValue t => Prism' t (Vector Value)
Prism' Value (Vector Value)
_Array
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Value -> Bool) -> [Value] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Value -> Bool
forall {s}. AsValue s => s -> Bool
isGood [Value]
samples) (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      String
"None of the samples in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall b a. (Show a, IsString b) => a -> b
show String
goldenFile String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" contains confirmed transactions"

  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"matches JSON schema" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
1 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
      [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
        [ forall a.
(HasCallStack, ToJSON a, Arbitrary a, Show a) =>
String -> Traversal' Value Value -> Property
prop_validateJSONSchema @(TimedServerOutput Tx) String
"api.json" (Traversal' Value Value -> Property)
-> Traversal' Value Value -> Property
forall a b. (a -> b) -> a -> b
$
            Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"components" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"schemas" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"ServerOutput"
        , forall a.
(HasCallStack, ToJSON a, Arbitrary a, Show a) =>
String -> Traversal' Value Value -> Property
prop_validateJSONSchema @(Greetings Tx) String
"api.json" (Traversal' Value Value -> Property)
-> Traversal' Value Value -> Property
forall a b. (a -> b) -> a -> b
$
            Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"components" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"schemas" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"Greetings"
        , forall a.
(HasCallStack, ToJSON a, Arbitrary a, Show a) =>
String -> Traversal' Value Value -> Property
prop_validateJSONSchema @(ClientMessage Tx) String
"api.json" (Traversal' Value Value -> Property)
-> Traversal' Value Value -> Property
forall a b. (a -> b) -> a -> b
$
            Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"components" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"schemas" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"ClientMessage"
        ]

  -- XXX: This seems no to be working? Adding a new message does not lead to a failure here
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"schema covers all defined server outputs" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      [ forall a.
(Arbitrary a, Show a) =>
String -> Traversal' Value Value -> Property
prop_specIsComplete @(TimedServerOutput Tx) String
"api.json" (Traversal' Value Value -> Property)
-> Traversal' Value Value -> Property
forall a b. (a -> b) -> a -> b
$
          Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"channels" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"/" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"subscribe" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"message"
      , forall a.
(Arbitrary a, Show a) =>
String -> Traversal' Value Value -> Property
prop_specIsComplete @(Greetings Tx) String
"api.json" (Traversal' Value Value -> Property)
-> Traversal' Value Value -> Property
forall a b. (a -> b) -> a -> b
$
          Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"channels" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"/" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"subscribe" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"message"
      , forall a.
(Arbitrary a, Show a) =>
String -> Traversal' Value Value -> Property
prop_specIsComplete @(ClientMessage Tx) String
"api.json" (Traversal' Value Value -> Property)
-> Traversal' Value Value -> Property
forall a b. (a -> b) -> a -> b
$
          Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"channels" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"/" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"subscribe" ((Value -> f Value) -> Value -> f Value)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> Value
-> f Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"message"
      ]