11
11
{-# LANGUAGE StandaloneDeriving #-}
12
12
{-# LANGUAGE StrictData #-}
13
13
{-# LANGUAGE TemplateHaskell #-}
14
-
14
+ {-# LANGUAGE ViewPatterns #-}
15
15
-- The hlint parser fails on the `pattern` function, so we disable the
16
16
-- language extension here.
17
17
{-# LANGUAGE NoPatternSynonyms #-}
@@ -161,8 +161,9 @@ import Data.Swagger.Internal.TypeShape (GenericHasSimpleShape,
161
161
GenericShape )
162
162
import Data.Text (Text , dropEnd , toLower )
163
163
import qualified Data.Text as T
164
- import Data.Version (Version )
165
- import Formatting (bprint , build , fconst , int , sformat , stext , (%) )
164
+ import Data.Version (Version (.. ), parseVersion , showVersion )
165
+ import Formatting (bprint , build , fconst , int , sformat , shown , stext ,
166
+ (%) )
166
167
import qualified Formatting.Buildable
167
168
import Generics.SOP.TH (deriveGeneric )
168
169
import GHC.Generics (Generic , Rep )
@@ -186,7 +187,6 @@ import Cardano.Wallet.API.V1.Generic (jsendErrorGenericParseJSON,
186
187
jsendErrorGenericToJSON )
187
188
import Cardano.Wallet.API.V1.Swagger.Example (Example , example ,
188
189
genExample )
189
- import Cardano.Wallet.Orphans.Aeson ()
190
190
import Cardano.Wallet.Types.UtxoStatistics
191
191
import Cardano.Wallet.Util (mkJsonKey , showApiUtcTime )
192
192
@@ -195,7 +195,6 @@ import qualified Pos.Binary.Class as Bi
195
195
import qualified Pos.Chain.Txp as Txp
196
196
import qualified Pos.Chain.Update as Core
197
197
import qualified Pos.Client.Txp.Util as Core
198
- import Pos.Core (addressF )
199
198
import qualified Pos.Core as Core
200
199
import Pos.Crypto (Hash , PublicKey (.. ), decodeHash , hashHexF )
201
200
import qualified Pos.Crypto.Signing as Core
@@ -206,7 +205,9 @@ import Pos.Infra.Util.LogSafe (BuildableSafeGen (..), SecureLog (..),
206
205
buildSafe , buildSafeList , buildSafeMaybe ,
207
206
deriveSafeBuildable , plainOrSecureF )
208
207
import Pos.Util.Servant (Flaggable (.. ))
208
+ import Test.Pos.Chain.Update.Arbitrary ()
209
209
import Test.Pos.Core.Arbitrary ()
210
+ import Text.ParserCombinators.ReadP (readP_to_S )
210
211
211
212
-- | Declare generic schema, while documenting properties
212
213
-- For instance:
@@ -312,7 +313,7 @@ instance Bounded a => Bounded (V1 a) where
312
313
minBound = V1 $ minBound @ a
313
314
maxBound = V1 $ maxBound @ a
314
315
315
- instance Buildable a => Buildable (V1 a ) where
316
+ instance {-# OVERLAPPABLE #-} Buildable a => Buildable (V1 a ) where
316
317
build (V1 x) = bprint build x
317
318
318
319
instance Buildable (SecureLog a ) => Buildable (SecureLog (V1 a )) where
@@ -321,7 +322,6 @@ instance Buildable (SecureLog a) => Buildable (SecureLog (V1 a)) where
321
322
instance (Buildable a , Buildable b ) => Buildable (a , b ) where
322
323
build (a, b) = bprint (" (" % build% " , " % build% " )" ) a b
323
324
324
-
325
325
--
326
326
-- Benign instances
327
327
--
@@ -380,8 +380,17 @@ instance ToSchema (V1 Core.Coin) where
380
380
& type_ .~ SwaggerNumber
381
381
& maximum_ .~ Just (fromIntegral Core. maxCoinVal)
382
382
383
+ instance ToHttpApiData Core. Coin where
384
+ toQueryParam = pretty . Core. coinToInteger
385
+
386
+ instance FromHttpApiData Core. Coin where
387
+ parseUrlPiece p = do
388
+ c <- Core. Coin <$> parseQueryParam p
389
+ Core. checkCoin c
390
+ pure c
391
+
383
392
instance ToJSON (V1 Core. Address ) where
384
- toJSON (V1 c) = String $ sformat addressF c
393
+ toJSON (V1 c) = String $ sformat Core. addressF c
385
394
386
395
instance FromJSON (V1 Core. Address ) where
387
396
parseJSON (String a) = case Core. decodeTextAddress a of
@@ -2405,17 +2414,36 @@ instance BuildableSafeGen SlotDuration where
2405
2414
data NodeSettings = NodeSettings {
2406
2415
setSlotDuration :: ! SlotDuration
2407
2416
, setSoftwareInfo :: ! (V1 Core. SoftwareVersion )
2408
- , setProjectVersion :: ! Version
2417
+ , setProjectVersion :: ! ( V1 Version )
2409
2418
, setGitRevision :: ! Text
2410
2419
} deriving (Show , Eq , Generic )
2411
2420
2412
2421
#if !(MIN_VERSION_swagger2(2,2,2))
2413
2422
-- See note [Version Orphan]
2414
- instance ToSchema Version where
2423
+ instance ToSchema ( V1 Version ) where
2415
2424
declareNamedSchema _ =
2416
- pure $ NamedSchema (Just " Version " ) $ mempty
2425
+ pure $ NamedSchema (Just " V1Version " ) $ mempty
2417
2426
& type_ .~ SwaggerString
2418
2427
2428
+ instance Buildable (V1 Version ) where
2429
+ build (V1 v) = bprint shown v
2430
+
2431
+ instance Buildable (SecureLog (V1 Version )) where
2432
+ build (SecureLog x) = Formatting.Buildable. build x
2433
+
2434
+ instance ToJSON (V1 Version ) where
2435
+ toJSON (V1 v) = toJSON (showVersion v)
2436
+
2437
+ instance FromJSON (V1 Version ) where
2438
+ parseJSON (String v) = case readP_to_S parseVersion (T. unpack v) of
2439
+ (reverse -> ((ver,_): _)) -> pure (V1 ver)
2440
+ _ -> mempty
2441
+ parseJSON x = typeMismatch " Not a valid Version" x
2442
+
2443
+ instance Arbitrary (V1 Version ) where
2444
+ arbitrary = fmap V1 arbitrary
2445
+
2446
+
2419
2447
-- Note [Version Orphan]
2420
2448
-- I have opened a PR to add an instance of 'Version' to the swagger2
2421
2449
-- library. When the PR is merged, we can delete the instance here and remove the warning from the file.
0 commit comments