content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GADTs #-}
  {-# OPTIONS_GHC -Wno-orphans #-}
  
  module Language.Marlowe.Protocol.QuerySpec where
  
  import Data.Foldable (fold)
  import Language.Marlowe.Protocol.Query.Types
  import Language.Marlowe.Runtime.Core.Api (MarloweVersion (..), MarloweVersionTag (V1))
  import Language.Marlowe.Runtime.Discovery.Gen ()
  import Network.Protocol.Codec.Spec
  import Network.Protocol.Query.Types
  import Spec.Marlowe.Semantics.Arbitrary ()
  import Test.Hspec (Spec, describe)
  import Test.Hspec.QuickCheck (prop)
  import Test.QuickCheck hiding (shrinkMap)
  
  spec :: Spec
  spec = describe "MarloweQuery protocol" do
    prop "Has a lawful codec" $ checkPropCodec @MarloweQuery
    codecGoldenTests @MarloweQuery "MarloweQuery"
  
  instance ArbitraryRequest MarloweSyncRequest where
    arbitraryTag =
      elements
        [ SomeTag TagContractHeaders
        , SomeTag TagContractState
        , SomeTag TagTransaction
        , SomeTag TagTransactions
        , SomeTag TagWithdrawal
        , SomeTag TagWithdrawals
        , SomeTag TagPayout
        , SomeTag TagPayouts
        , SomeTag TagRoleCurrencies
        , SomeTag TagStatus
        ]
    arbitraryReq = \case
      TagContractHeaders -> ReqContractHeaders <$> arbitrary <*> arbitrary
      TagContractState -> ReqContractState <$> arbitrary
      TagTransaction -> ReqTransaction <$> arbitrary
      TagTransactions -> ReqTransactions <$> arbitrary
      TagWithdrawal -> ReqWithdrawal <$> arbitrary
      TagWithdrawals -> ReqWithdrawals <$> arbitrary <*> arbitrary
      TagStatus -> pure ReqStatus
      TagPayouts -> ReqPayouts <$> arbitrary <*> arbitrary
      TagPayout -> ReqPayout <$> arbitrary
      TagRoleCurrencies -> ReqRoleCurrencies <$> arbitrary
  
    shrinkReq = \case
      ReqContractHeaders cFilter range ->
        fold
          [ ReqContractHeaders <$> shrink cFilter <*> pure range
          , ReqContractHeaders cFilter <$> shrink range
          ]
      ReqContractState contractId -> ReqContractState <$> shrink contractId
      ReqTransaction txId -> ReqTransaction <$> shrink txId
      ReqTransactions contractId -> ReqTransactions <$> shrink contractId
      ReqWithdrawal txId -> ReqWithdrawal <$> shrink txId
      ReqWithdrawals wFilter range ->
        fold
          [ ReqWithdrawals <$> shrink wFilter <*> pure range
          , ReqWithdrawals wFilter <$> shrink range
          ]
      ReqStatus -> []
      ReqPayouts pFilter range ->
        fold
          [ ReqPayouts <$> shrink pFilter <*> pure range
          , ReqPayouts pFilter <$> shrink range
          ]
      ReqPayout payoutId -> ReqPayout <$> shrink payoutId
      ReqRoleCurrencies cFilter -> ReqRoleCurrencies <$> shrink cFilter
  
    arbitraryResult = \case
      TagContractHeaders -> arbitrary
      TagContractState -> arbitrary
      TagTransaction -> arbitrary
      TagTransactions -> arbitrary
      TagWithdrawal -> arbitrary
      TagWithdrawals -> arbitrary
      TagStatus -> arbitrary
      TagPayouts -> arbitrary
      TagPayout -> arbitrary
      TagRoleCurrencies -> arbitrary
  
    shrinkResult = \case
      TagContractHeaders -> shrink
      TagContractState -> shrink
      TagTransaction -> shrink
      TagTransactions -> shrink
      TagWithdrawal -> shrink
      TagWithdrawals -> shrink
      TagStatus -> shrink
      TagPayouts -> shrink
      TagPayout -> shrink
      TagRoleCurrencies -> shrink
  
  instance Arbitrary RoleCurrency where
    arbitrary = RoleCurrency <$> arbitrary <*> arbitrary <*> arbitrary
    shrink = genericShrink
  
  instance Arbitrary RoleCurrencyFilter where
    arbitrary = sized \case
      0 ->
        frequency
          [ (1, pure RoleCurrencyFilterNone)
          , (1, pure RoleCurrencyFilterAny)
          , (5, RoleCurrencyFilterByContract <$> arbitrary)
          , (5, RoleCurrencyFilterByPolicy <$> arbitrary)
          ]
      size ->
        frequency
          [ (1, pure RoleCurrencyFilterNone)
          , (1, pure RoleCurrencyFilterAny)
          , (5, resize (size `div` 2) $ RoleCurrencyOr <$> arbitrary <*> arbitrary)
          , (5, resize (size `div` 2) $ RoleCurrencyAnd <$> arbitrary <*> arbitrary)
          , (3, resize (size - 1) $ RoleCurrencyNot <$> arbitrary)
          , (5, RoleCurrencyFilterByContract <$> arbitrary)
          , (5, RoleCurrencyFilterByPolicy <$> arbitrary)
          ]
    shrink = genericShrink
  
  instance Arbitrary SomeContractState where
    arbitrary = SomeContractState MarloweV1 <$> arbitrary
    shrink (SomeContractState MarloweV1 state) = SomeContractState MarloweV1 <$> shrink state
  
  instance Arbitrary SomePayoutState where
    arbitrary = SomePayoutState MarloweV1 <$> arbitrary
    shrink (SomePayoutState MarloweV1 state) = SomePayoutState MarloweV1 <$> shrink state
  
  instance Arbitrary RuntimeStatus where
    arbitrary =
      RuntimeStatus
        <$> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
    shrink RuntimeStatus{..} =
      fold
        [ [RuntimeStatus{nodeTip = x, ..} | x <- shrink nodeTip]
        , [RuntimeStatus{nodeTipUTC = x, ..} | x <- shrink nodeTipUTC]
        , [RuntimeStatus{runtimeChainTip = x, ..} | x <- shrink runtimeChainTip]
        , [RuntimeStatus{runtimeChainTipUTC = x, ..} | x <- shrink runtimeChainTipUTC]
        , [RuntimeStatus{runtimeTip = x, ..} | x <- shrink runtimeTip]
        , [RuntimeStatus{runtimeTipUTC = x, ..} | x <- shrink runtimeTipUTC]
        , [RuntimeStatus{networkId = x, ..} | x <- shrink networkId]
        , [RuntimeStatus{runtimeVersion = x, ..} | x <- shrink runtimeVersion]
        ]
  
  instance Arbitrary SomeTransaction where
    arbitrary = SomeTransaction MarloweV1 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
    shrink (SomeTransaction MarloweV1 input inputDatum consumedBy state) =
      fold
        [ SomeTransaction MarloweV1 input inputDatum consumedBy <$> shrink state
        , SomeTransaction MarloweV1 input inputDatum <$> shrink consumedBy <*> pure state
        , SomeTransaction MarloweV1 input <$> shrink inputDatum <*> pure consumedBy <*> pure state
        ]
  
  instance Arbitrary SomeTransactions where
    arbitrary = SomeTransactions MarloweV1 <$> arbitrary
    shrink (SomeTransactions MarloweV1 txs) = SomeTransactions MarloweV1 <$> shrink txs
  
  instance Arbitrary (ContractState 'V1) where
    arbitrary =
      ContractState
        <$> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
    shrink = genericShrink
  
  instance Arbitrary (PayoutState 'V1) where
    arbitrary = PayoutState <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
    shrink = genericShrink
  
  instance (Arbitrary a, Arbitrary b) => Arbitrary (Page a b) where
    arbitrary = Page <$> arbitrary <*> arbitrary <*> arbitrary
    shrink = genericShrink
  
  instance (Arbitrary a) => Arbitrary (Range a) where
    arbitrary = Range <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
    shrink = genericShrink
  
  instance Arbitrary PayoutHeader where
    arbitrary = PayoutHeader <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
    shrink = genericShrink
  
  instance Arbitrary Withdrawal where
    arbitrary = Withdrawal <$> arbitrary <*> arbitrary <*> arbitrary
    shrink = genericShrink
  
  instance Arbitrary Order where
    arbitrary = elements [Ascending, Descending]
  
  instance Arbitrary ContractFilter where
    arbitrary = ContractFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
    shrink = genericShrink
  
  instance Arbitrary WithdrawalFilter where
    arbitrary = WithdrawalFilter <$> arbitrary
    shrink = genericShrink
  
  instance Arbitrary PayoutFilter where
    arbitrary = PayoutFilter <$> arbitrary <*> arbitrary <*> arbitrary
    shrink = genericShrink
  