add 'validateEveryJSON' from servant-swagger to control that API type…

…s we generate are actually compliant with the spec
cardano-foundation · Mar 22, 2019 · 2c62b6f · 2c62b6f
1 parent 226a37b
commit 2c62b6f
Show file tree

Hide file tree

Showing 4 changed files with 169 additions and 119 deletions.
diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal
@@ -107,18 +107,23 @@ test-suite unit
     , containers
     , deepseq
     , exceptions
+    , file-embed
     , fmt
     , generic-arbitrary
+    , lens
     , hspec
     , hspec-golden-aeson
     , memory
     , process
     , QuickCheck
     , quickcheck-instances
+    , servant-swagger
+    , swagger2
     , text
     , time-units
     , transformers
     , uuid-types
+    , yaml
   type:
      exitcode-stdio-1.0
   hs-source-dirs:

diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml
@@ -370,127 +370,128 @@ networkInformationSoftwareUpdate: &networkInformationSoftwareUpdate
 
 #############################################################################
 #                                                                           #
-#                                RESOURCES                                  #
+#                              DEFINITIONS                                  #
 #                                                                           #
 #############################################################################
 
-address: &address
-  type: object
-  required:
-    - id
-    - state
-  properties:
-    id: *addressId
-    state: *addressState
-
-networkInformation: &networkInformation
-  type: object
-  required:
-    - blockchainHeight
-    - localHeight
-    - ntpStatus
-    - software_update
-    - syncProgress
-    - tip
-  properties:
-    blockchainHeight: *networkInformationBlockchainHeight
-    localHeight: *networkInformationLocalHeight
-    ntpStatus: *networkInformationNtpStatus
-    software_update: *networkInformationSoftwareUpdate
-    syncProgress: *networkInformationSyncProgress
-    tip: *networkInformationTip
-
-stakePool: &stakePool
-  type: object
-  required:
-    - id
-    - ticker
-    - metrics
-    - profit_margin
-  properties:
-    id: *stakePoolId
-    ticker: *stakePoolTicker
-    metrics: *stakePoolMetrics
-    profit_margin: *stakePoolProfitMargin
+definitions:
+  Address: &address
+    type: object
+    required:
+      - id
+      - state
+    properties:
+      id: *addressId
+      state: *addressState
 
-transaction: &transaction
-  type: object
-  required:
-    - id
-    - amount
-    - depth
-    - direction
-    - inputs
-    - outputs
-    - status
-  properties:
-    id: *transactionId
-    amount: *transactionAmount
-    inserted_at: *transactionInsertedAt
-    depth: *transactionDepth
-    direction: *transactionDirection
-    inputs: *transactionInputs
-    outputs: *transactionOutputs
-    status: *transactionStatus
-
-wallet: &wallet
-  type: object
-  required:
-    - id
-    - address_pool_gap
-    - balance
-    - delegation
-    - name
-    - passphrase
-    - state
-  properties:
-    id: *walletId
-    address_pool_gap: *walletAddressPoolGap
-    balance: *walletBalance
-    delegation: *walletDelegation
-    name: *walletName
-    passphrase: *walletPassphraseInfo
-    state: *walletState
+  NetworkInformation: &networkInformation
+    type: object
+    required:
+      - blockchainHeight
+      - localHeight
+      - ntpStatus
+      - software_update
+      - syncProgress
+      - tip
+    properties:
+      blockchainHeight: *networkInformationBlockchainHeight
+      localHeight: *networkInformationLocalHeight
+      ntpStatus: *networkInformationNtpStatus
+      software_update: *networkInformationSoftwareUpdate
+      syncProgress: *networkInformationSyncProgress
+      tip: *networkInformationTip
+
+  StakePool: &stakePool
+    type: object
+    required:
+      - id
+      - ticker
+      - metrics
+      - profit_margin
+    properties:
+      id: *stakePoolId
+      ticker: *stakePoolTicker
+      metrics: *stakePoolMetrics
+      profit_margin: *stakePoolProfitMargin
 
-walletUTxOsStatistics: &walletUTxOsStatistics
-  type: object
-  required:
-    - total
-    - scale
-    - distribution
-  properties:
-    total: *amount
-    scale:
-      type: string
-      enum:
-        - log10
-    distribution:
-      type: object
-      additionalProperties:
-        type: integer
-  example:
-    total:
-      quantity: 42000000
-      unit: lovelace
-    scale: log10
-    distribution:
-      10: 1
-      100: 0
-      1000: 8
-      10000: 14
-      100000: 32
-      1000000: 3
-      10000000: 0
-      100000000: 12
-      1000000000: 0
-      10000000000: 0
-      100000000000: 0
-      1000000000000: 0
-      10000000000000: 0
-      100000000000000: 0
-      1000000000000000: 0
-      10000000000000000: 0
-      45000000000000000: 0
+  Transaction: &transaction
+    type: object
+    required:
+      - id
+      - amount
+      - depth
+      - direction
+      - inputs
+      - outputs
+      - status
+    properties:
+      id: *transactionId
+      amount: *transactionAmount
+      inserted_at: *transactionInsertedAt
+      depth: *transactionDepth
+      direction: *transactionDirection
+      inputs: *transactionInputs
+      outputs: *transactionOutputs
+      status: *transactionStatus
+
+  Wallet: &wallet
+    type: object
+    required:
+      - id
+      - address_pool_gap
+      - balance
+      - delegation
+      - name
+      - passphrase
+      - state
+    properties:
+      id: *walletId
+      address_pool_gap: *walletAddressPoolGap
+      balance: *walletBalance
+      delegation: *walletDelegation
+      name: *walletName
+      passphrase: *walletPassphraseInfo
+      state: *walletState
+
+  WalletUTxOsStatistics: &walletUTxOsStatistics
+    type: object
+    required:
+      - total
+      - scale
+      - distribution
+    properties:
+      total: *amount
+      scale:
+        type: string
+        enum:
+          - log10
+      distribution:
+        type: object
+        additionalProperties:
+          type: integer
+    example:
+      total:
+        quantity: 42000000
+        unit: lovelace
+      scale: log10
+      distribution:
+        10: 1
+        100: 0
+        1000: 8
+        10000: 14
+        100000: 32
+        1000000: 3
+        10000000: 0
+        100000000: 12
+        1000000000: 0
+        10000000000: 0
+        100000000000: 0
+        1000000000000: 0
+        10000000000000: 0
+        100000000000000: 0
+        1000000000000000: 0
+        10000000000000000: 0
+        45000000000000000: 0
 
 
 #############################################################################
@@ -588,7 +589,8 @@ parametersQuitStakePool: &parametersQuitStakePool
 
 responsesErr: &responsesErr
   type: object
-  required: message
+  required:
+    - message
   properties:
     message:
       type: string

diff --git a/src/Cardano/Wallet/Api.hs b/src/Cardano/Wallet/Api.hs
@@ -17,7 +17,7 @@ type Api = DeleteWallet :<|> GetWallet :<|> ListWallets
 
 type DeleteWallet = "wallets"
     :> Capture "walletId" WalletId
-    :> Delete '[JSON] NoContent
+    :> Delete '[] NoContent
 
 type GetWallet = "wallets"
     :> Capture "walletId" WalletId

diff --git a/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/test/unit/Cardano/Wallet/Api/TypesSpec.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -12,6 +13,8 @@ import Prelude
 
 import Cardano.Wallet
     ( mkWalletName, walletNameMaxLength, walletNameMinLength )
+import Cardano.Wallet.Api
+    ( api )
 import Cardano.Wallet.Api.Types
     ( AddressPoolGap
     , ApiT (..)
@@ -24,20 +27,28 @@ import Cardano.Wallet.Api.Types
     , WalletPassphraseInfo (..)
     , WalletState (..)
     )
+import Control.Lens
+    ( at, (^.) )
 import Control.Monad
     ( replicateM )
 import Data.Aeson
     ( FromJSON, ToJSON )
 import Data.Either
     ( rights )
+import Data.FileEmbed
+    ( embedFile )
 import Data.Quantity
     ( Quantity (..) )
+import Data.Swagger
+    ( NamedSchema (..), Swagger, ToSchema (..), definitions )
 import Data.Typeable
     ( Typeable )
 import Data.Word
     ( Word32, Word8 )
 import Numeric.Natural
     ( Natural )
+import Servant.Swagger.Test
+    ( validateEveryToJSON )
 import Test.Aeson.GenericSpecs
     ( GoldenDirectoryOption (CustomDirectoryName)
     , Proxy (Proxy)
@@ -49,7 +60,7 @@ import Test.Aeson.GenericSpecs
     , useModuleNameAsSubDirectory
     )
 import Test.Hspec
-    ( Spec, describe )
+    ( Spec, describe, runIO )
 import Test.QuickCheck
     ( Arbitrary (..), arbitraryBoundedEnum, arbitraryPrintableChar, choose )
 import Test.QuickCheck.Arbitrary.Generic
@@ -59,6 +70,7 @@ import Test.QuickCheck.Instances.Time
 
 import qualified Data.Text as T
 import qualified Data.UUID.Types as UUID
+import qualified Data.Yaml as Yaml
 
 spec :: Spec
 spec = do
@@ -75,6 +87,11 @@ spec = do
             roundtripAndGolden $ Proxy @ (ApiT WalletPassphraseInfo)
             roundtripAndGolden $ Proxy @ (ApiT WalletState)
 
+    runIO $ print (specification ^. definitions)
+
+    describe "api matches the swagger specification" $
+        validateEveryToJSON api
+
 -- | Run JSON roundtrip & golden tests
 --
 -- Golden tests files are generated automatically on first run. On later runs
@@ -164,3 +181,29 @@ instance Arbitrary WalletState where
 instance Arbitrary a => Arbitrary (ApiT a) where
     arbitrary = ApiT <$> arbitrary
     shrink = fmap ApiT . shrink . getApiT
+
+
+{-------------------------------------------------------------------------------
+                              ToSchema Instances
+-------------------------------------------------------------------------------}
+
+specification :: Swagger
+specification =
+    unsafeDecode bytes
+  where
+    unsafeDecode =
+        either
+        ( error
+        . ("Whoops! Failed to parse or find the api specification document: " <>)
+        . show
+        )
+        id
+        . Yaml.decodeEither'
+    bytes = $(embedFile "specifications/api/swagger.yaml")
+
+instance ToSchema Wallet where
+    declareNamedSchema _ = case specification ^. definitions . at "Wallet" of
+        Nothing ->
+            error "unable to find the definition for 'Wallet' in the spec"
+        Just schema ->
+            return $ NamedSchema (Just "Wallet") schema