diff --git a/wallet-new/src/Cardano/Wallet/API/Response.hs b/wallet-new/src/Cardano/Wallet/API/Response.hs index 9e5fcfaa64d..5f1ddd9bb24 100644 --- a/wallet-new/src/Cardano/Wallet/API/Response.hs +++ b/wallet-new/src/Cardano/Wallet/API/Response.hs @@ -16,12 +16,13 @@ import Prelude import Universum (Buildable, decodeUtf8, toText, (<>)) import Cardano.Wallet.API.Response.JSend (ResponseStatus (..)) +import Cardano.Wallet.API.V1.Swagger.Example (Example, example) import Control.Lens import Data.Aeson import Data.Aeson.Encode.Pretty (encodePretty) import Data.Aeson.TH import qualified Data.Char as Char -import Data.Swagger as S +import Data.Swagger as S hiding (Example, example) import qualified Data.Text.Buildable import Data.Typeable import Formatting (bprint, build, (%)) @@ -159,6 +160,12 @@ paginate PaginationParams{..} rawResultSet = slice = take pp . drop ((cp - 1) * pp) in (slice rawResultSet, metadata) +instance Example Metadata +instance Example a => Example (WalletResponse a) where + example = WalletResponse <$> example + <*> pure SuccessStatus + <*> example + -- | Creates a 'WalletResponse' with just a single record into it. single :: a -> WalletResponse a diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Swagger/Example.hs b/wallet-new/src/Cardano/Wallet/API/V1/Swagger/Example.hs index 1fc33e77932..eb2eca83875 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Swagger/Example.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Swagger/Example.hs @@ -2,22 +2,14 @@ module Cardano.Wallet.API.V1.Swagger.Example where import Universum -import Test.QuickCheck (Arbitrary (..), Gen, listOf1, oneof) +import Test.QuickCheck (Arbitrary (..), Gen, listOf1) -import Cardano.Wallet.API.Response -import Cardano.Wallet.API.V1.Types import Cardano.Wallet.Orphans.Arbitrary () -import Data.Default (Default (def)) -import Node (NodeId (..)) import Pos.Arbitrary.Wallet.Web.ClientTypes () -import Pos.Client.Txp.Util (InputSelectionPolicy (..)) -import Pos.Util.Mnemonic (Mnemonic) import Pos.Wallet.Web.ClientTypes (CUpdateInfo) import Pos.Wallet.Web.Methods.Misc (WalletStateSnapshot (..)) import qualified Data.Map.Strict as Map -import qualified Pos.Core.Common as Core -import qualified Pos.Crypto.Signing as Core class Arbitrary a => Example a where @@ -39,109 +31,10 @@ instance Example a => Example (Maybe a) where instance (Ord k, Example k, Example v) => Example (Map k v) where example = Map.fromList <$> listOf1 ((,) <$> example <*> example) -instance Example (V1 Core.PassPhrase) -instance Example (V1 Core.Coin) - -instance Example a => Example (WalletResponse a) where - example = WalletResponse <$> example - <*> pure SuccessStatus - <*> example - --- | We have a specific 'Example' instance for @'V1' 'Address'@ because we want --- to control the length of the examples. It is possible for the encoded length --- to become huge, up to 1000+ bytes, if the 'UnsafeMultiKeyDistr' constructor --- is used. We do not use this constructor, which keeps the address between --- ~80-150 bytes long. -instance Example (V1 Address) where - example = fmap V1 . Core.makeAddress - <$> arbitrary - <*> arbitraryAttributes - where - arbitraryAttributes = - Core.AddrAttributes - <$> arbitrary - <*> oneof - [ pure Core.BootstrapEraDistr - , Core.SingleKeyDistr <$> arbitrary - ] - -instance Example (Mnemonic 12) where - example = pure def - -instance Example (V1 (Mnemonic 12)) where - example = V1 <$> example - -instance Example Address -instance Example Metadata -instance Example AccountIndex -instance Example AccountBalance -instance Example AccountAddresses -instance Example WalletId -instance Example AssuranceLevel -instance Example SyncPercentage -instance Example BlockchainHeight -instance Example LocalTimeDifference -instance Example PaymentDistribution -instance Example AccountUpdate -instance Example Wallet -instance Example WalletUpdate -instance Example WalletOperation -instance Example PasswordUpdate -instance Example EstimatedFees -instance Example Transaction -instance Example WalletSoftwareUpdate -instance Example NodeSettings -instance Example SlotDuration -instance Example WalletAddress -instance Example NewAccount -instance Example TimeInfo -instance Example AddressValidity -instance Example NewAddress instance Example CUpdateInfo -instance Example SubscriptionStatus -instance Example NodeId - -instance Example InputSelectionPolicy where - example = pure OptimizeForHighThroughput - -instance Example (V1 InputSelectionPolicy) where - example = pure (V1 OptimizeForHighThroughput) - -instance Example Account where - example = Account <$> example - <*> example -- NOTE: this will produce non empty list - <*> example - <*> pure "My account" - <*> example - -instance Example NewWallet where - example = NewWallet <$> example - <*> example -- Note: will produce `Just a` - <*> example - <*> pure "My Wallet" - <*> example - -instance Example NodeInfo where - example = NodeInfo <$> example - <*> example -- NOTE: will produce `Just a` - <*> example - <*> example - <*> example - -instance Example PaymentSource where - example = PaymentSource <$> example - <*> example - -instance Example Payment where - example = Payment <$> example - <*> example - <*> example -- TODO: will produce `Just groupingPolicy` - <*> example - instance Example WalletStateSnapshot - -- IMPORTANT: if executing `grep "[]\|null" wallet-new/spec/swagger.json` returns any element - then we have to add Example instances for those objects because we don't want to see [] or null examples in our docs. -- -- TODO: We should probably add this as a part of our swagger CI script and fail swagger if we find some of them - with instruction to the developer above what is said above. diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Types.hs b/wallet-new/src/Cardano/Wallet/API/V1/Types.hs index 8899710b1f4..0a0900630b4 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Types.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Types.hs @@ -85,12 +85,15 @@ import Universum import Data.Semigroup (Semigroup) +import Cardano.Wallet.API.V1.Swagger.Example (Example, example) import Control.Lens (At, Index, IxValue, at, ix, makePrisms, to, (?~)) import Data.Aeson import Data.Aeson.TH as A import Data.Aeson.Types (toJSONKeyText, typeMismatch) import qualified Data.Char as C -import Data.Swagger as S +import Data.Default (Default (def)) +import Data.Swagger hiding (Example, example) +import qualified Data.Swagger as S import Data.Swagger.Declare (Declare, look) import Data.Swagger.Internal.Schema (GToSchema) import Data.Swagger.Internal.TypeShape (GenericHasSimpleShape, @@ -167,7 +170,7 @@ type IsPropertiesMap m = genericSchemaDroppingPrefix :: forall a m proxy. - ( Generic a, ToJSON a, Arbitrary a, GToSchema (Rep a), IsPropertiesMap m + ( Generic a, ToJSON a, Example a, GToSchema (Rep a), IsPropertiesMap m , GenericHasSimpleShape a "genericDeclareNamedSchemaUnrestricted" @@ -184,10 +187,10 @@ genericSchemaDroppingPrefix prfx extraDoc proxy = do defs <- look pure $ s & over schema (over properties (extraDoc (addFieldDescription defs))) - & schema . example ?~ toJSON (genExample :: a) + & schema . S.example ?~ toJSON (genExample :: a) where genExample = - (unGen (resize 3 arbitrary)) (mkQCGen 42) 42 + (unGen (resize 3 example)) (mkQCGen 42) 42 addFieldDescription defs field desc = over (at field) (addDescription defs field desc) @@ -700,6 +703,7 @@ deriveSafeBuildable ''SyncProgress instance BuildableSafeGen SyncProgress where buildSafeGen _ sp = bprint build sp +instance Example SyncProgress where instance Arbitrary SyncProgress where arbitrary = SyncProgress <$> arbitrary <*> arbitrary @@ -1828,3 +1832,103 @@ type family New (original :: *) :: * where type CaptureWalletId = Capture "walletId" WalletId type CaptureAccountId = Capture "accountId" AccountIndex + + +-- +-- Example typeclass instances +-- + +instance Example (Mnemonic 12) where + example = pure def + +instance Example (V1 (Mnemonic 12)) where + example = V1 <$> example + +instance Example Core.Address +instance Example AccountIndex +instance Example AccountBalance +instance Example AccountAddresses +instance Example WalletId +instance Example AssuranceLevel +instance Example SyncPercentage +instance Example BlockchainHeight +instance Example LocalTimeDifference +instance Example PaymentDistribution +instance Example AccountUpdate +instance Example Wallet +instance Example WalletUpdate +instance Example WalletOperation +instance Example PasswordUpdate +instance Example EstimatedFees +instance Example Transaction +instance Example WalletSoftwareUpdate +instance Example NodeSettings +instance Example SlotDuration +instance Example WalletAddress +instance Example NewAccount +instance Example TimeInfo +instance Example AddressValidity +instance Example NewAddress +instance Example SubscriptionStatus +instance Example NodeId + + + +-- | We have a specific 'Example' instance for @'V1' 'Address'@ because we want +-- to control the length of the examples. It is possible for the encoded length +-- to become huge, up to 1000+ bytes, if the 'UnsafeMultiKeyDistr' constructor +-- is used. We do not use this constructor, which keeps the address between +-- ~80-150 bytes long. +instance Example (V1 Core.Address) where + example = fmap V1 . Core.makeAddress + <$> arbitrary + <*> arbitraryAttributes + where + arbitraryAttributes = + Core.AddrAttributes + <$> arbitrary + <*> oneof + [ pure Core.BootstrapEraDistr + , Core.SingleKeyDistr <$> arbitrary + ] + +instance Example Core.InputSelectionPolicy where + example = pure Core.OptimizeForHighThroughput + +instance Example (V1 Core.InputSelectionPolicy) where + example = pure (V1 Core.OptimizeForHighThroughput) + + +instance Example Account where + example = Account <$> example + <*> example -- NOTE: this will produce non empty list + <*> example + <*> pure "My account" + <*> example + +instance Example NewWallet where + example = NewWallet <$> example + <*> example -- Note: will produce `Just a` + <*> example + <*> pure "My Wallet" + <*> example + +instance Example NodeInfo where + example = NodeInfo <$> example + <*> example -- NOTE: will produce `Just a` + <*> example + <*> example + <*> example + +instance Example PaymentSource where + example = PaymentSource <$> example + <*> example + +instance Example Payment where + example = Payment <$> example + <*> example + <*> example -- TODO: will produce `Just groupingPolicy` + <*> example + +instance Example (V1 Core.PassPhrase) +instance Example (V1 Core.Coin)