Merge pull request #3707 [remove wallet orphan instances] into CO-372/TheGreatCleanup

Author: KtorZ

wallet-new/cardano-sl-wallet-new.cabal

@@ -116,10 +116,6 @@ library
                        Cardano.Wallet.Kernel.Util.StrictNonEmpty
                        Cardano.Wallet.Kernel.Util.StrictStateT
                        Cardano.Wallet.Kernel.Wallets
-                       Cardano.Wallet.Orphans
-                       Cardano.Wallet.Orphans.Aeson
-                       Cardano.Wallet.Orphans.Arbitrary
-                       Cardano.Wallet.Orphans.Bi
                        Cardano.Wallet.Server
                        Cardano.Wallet.Server.CLI
                        Cardano.Wallet.Server.Middlewares

wallet-new/src/Cardano/Wallet/API/V1/Swagger/Example.hs

@@ -8,7 +8,6 @@ import           Data.Swagger (Definitions, NamedSchema (..), Schema,
 import           Data.Swagger.Declare (Declare)
 import           Data.Typeable (typeOf)
 
-import           Cardano.Wallet.Orphans.Arbitrary ()
 import           Test.QuickCheck (Arbitrary (..), listOf1)
 import           Test.QuickCheck.Gen (Gen (..), resize)
 import           Test.QuickCheck.Random (mkQCGen)
@@ -21,7 +20,7 @@ class Arbitrary a => Example a where
     example = arbitrary
 
 instance Example ()
-instance Example a => Example (NonEmpty a)
+instance (Example a, Arbitrary (NonEmpty a) ) => Example (NonEmpty a)
 
 -- NOTE: we don't want to see empty list examples in our swagger doc :)
 instance Example a => Example [a] where

wallet-new/src/Cardano/Wallet/API/V1/Types.hs

@@ -11,7 +11,7 @@
 {-# LANGUAGE StandaloneDeriving         #-}
 {-# LANGUAGE StrictData                 #-}
 {-# LANGUAGE TemplateHaskell            #-}
-
+{-# LANGUAGE ViewPatterns               #-}
 -- The hlint parser fails on the `pattern` function, so we disable the
 -- language extension here.
 {-# LANGUAGE NoPatternSynonyms          #-}
@@ -162,8 +162,9 @@ import           Data.Swagger.Internal.TypeShape (GenericHasSimpleShape,
                      GenericShape)
 import           Data.Text (Text, dropEnd, toLower)
 import qualified Data.Text as T
-import           Data.Version (Version)
-import           Formatting (bprint, build, fconst, int, sformat, stext, (%))
+import           Data.Version (Version (..), parseVersion, showVersion)
+import           Formatting (bprint, build, fconst, int, sformat, shown, stext,
+                     (%))
 import qualified Formatting.Buildable
 import           Generics.SOP.TH (deriveGeneric)
 import           GHC.Generics (Generic, Rep)
@@ -187,7 +188,6 @@ import           Cardano.Wallet.API.V1.Generic (jsendErrorGenericParseJSON,
                      jsendErrorGenericToJSON)
 import           Cardano.Wallet.API.V1.Swagger.Example (Example, example,
                      genExample)
-import           Cardano.Wallet.Orphans.Aeson ()
 import           Cardano.Wallet.Types.UtxoStatistics
 import           Cardano.Wallet.Util (mkJsonKey, showApiUtcTime)
 
@@ -196,7 +196,6 @@ import qualified Pos.Binary.Class as Bi
 import qualified Pos.Chain.Txp as Txp
 import qualified Pos.Chain.Update as Core
 import qualified Pos.Client.Txp.Util as Core
-import           Pos.Core (addressF)
 import qualified Pos.Core as Core
 import           Pos.Crypto (PublicKey (..), decodeHash, hashHexF)
 import qualified Pos.Crypto.Signing as Core
@@ -207,7 +206,9 @@ import           Pos.Infra.Util.LogSafe (BuildableSafeGen (..), SecureLog (..),
                      buildSafe, buildSafeList, buildSafeMaybe,
                      deriveSafeBuildable, plainOrSecureF)
 import           Pos.Util.Servant (Flaggable (..))
+import           Test.Pos.Chain.Update.Arbitrary ()
 import           Test.Pos.Core.Arbitrary ()
+import           Text.ParserCombinators.ReadP (readP_to_S)
 
 -- | Declare generic schema, while documenting properties
 --   For instance:
@@ -313,7 +314,7 @@ instance Bounded a => Bounded (V1 a) where
     minBound = V1 $ minBound @a
     maxBound = V1 $ maxBound @a
 
-instance Buildable a => Buildable (V1 a) where
+instance {-# OVERLAPPABLE #-} Buildable a => Buildable (V1 a) where
     build (V1 x) = bprint build x
 
 instance Buildable (SecureLog a) => Buildable (SecureLog (V1 a)) where
@@ -322,7 +323,6 @@ instance Buildable (SecureLog a) => Buildable (SecureLog (V1 a)) where
 instance (Buildable a, Buildable b) => Buildable (a, b) where
     build (a, b) = bprint ("("%build%", "%build%")") a b
 
-
 --
 -- Benign instances
 --
@@ -381,8 +381,17 @@ instance ToSchema (V1 Core.Coin) where
             & type_ .~ SwaggerNumber
             & maximum_ .~ Just (fromIntegral Core.maxCoinVal)
 
+instance ToHttpApiData Core.Coin where
+    toQueryParam = pretty . Core.coinToInteger
+
+instance FromHttpApiData Core.Coin where
+    parseUrlPiece p = do
+        c <- Core.Coin <$> parseQueryParam p
+        Core.checkCoin c
+        pure c
+
 instance ToJSON (V1 Core.Address) where
-    toJSON (V1 c) = String $ sformat addressF c
+    toJSON (V1 c) = String $ sformat Core.addressF c
 
 instance FromJSON (V1 Core.Address) where
     parseJSON (String a) = case Core.decodeTextAddress a of
@@ -2346,17 +2355,36 @@ instance BuildableSafeGen SlotDuration where
 data NodeSettings = NodeSettings {
      setSlotDuration   :: !SlotDuration
    , setSoftwareInfo   :: !(V1 Core.SoftwareVersion)
-   , setProjectVersion :: !Version
+   , setProjectVersion :: !(V1 Version)
    , setGitRevision    :: !Text
    } deriving (Show, Eq, Generic)
 
 #if !(MIN_VERSION_swagger2(2,2,2))
 -- See note [Version Orphan]
-instance ToSchema Version where
+instance ToSchema (V1 Version) where
     declareNamedSchema _ =
-        pure $ NamedSchema (Just "Version") $ mempty
+        pure $ NamedSchema (Just "V1Version") $ mempty
             & type_ .~ SwaggerString
 
+instance Buildable (V1 Version) where
+    build (V1 v) = bprint shown v
+
+instance Buildable (SecureLog (V1 Version)) where
+    build (SecureLog x) = Formatting.Buildable.build x
+
+instance ToJSON (V1 Version) where
+    toJSON (V1 v) = toJSON (showVersion v)
+
+instance FromJSON (V1 Version) where
+    parseJSON (String v) = case readP_to_S parseVersion (T.unpack v) of
+        (reverse -> ((ver,_):_)) -> pure (V1 ver)
+        _                        -> mempty
+    parseJSON x                  = typeMismatch "Not a valid Version" x
+
+instance Arbitrary (V1 Version) where
+    arbitrary = fmap V1 arbitrary
+
+
 -- Note [Version Orphan]
 -- I have opened a PR to add an instance of 'Version' to the swagger2
 -- library. When the PR is merged, we can delete the instance here and remove the warning from the file.

wallet-new/src/Cardano/Wallet/Kernel/DB/Util/AcidState.hs

@@ -47,7 +47,6 @@ import           Cardano.Wallet.Kernel.DB.Util.IxSet (HasPrimKey, Indexable,
 import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
 import qualified Cardano.Wallet.Kernel.DB.Util.Zoomable as Z
 import           Cardano.Wallet.Kernel.Util.StrictStateT
-import           Cardano.Wallet.Orphans ()
 import           UTxO.Util (mustBeRight)
 
 {-------------------------------------------------------------------------------

wallet-new/src/Cardano/Wallet/Orphans.hs

@@ -22,7 +22,7 @@ getNodeSettings w = liftIO $
     V1.NodeSettings
       <$> (mkSlotDuration <$> Node.getNextEpochSlotDuration node)
       <*> (V1 <$> Node.curSoftwareVersion node)
-      <*> pure version
+      <*> pure (V1 version)
       <*> (mkGitRevision <$> Node.compileInfo node)
   where
     mkSlotDuration :: Millisecond -> V1.SlotDuration

wallet-new/src/Cardano/Wallet/Orphans/Aeson.hs

@@ -9,7 +9,6 @@ module Cardano.Wallet.WalletLayer.QuickCheck
 import           Universum
 
 import           Cardano.Wallet.Kernel.Diffusion (WalletDiffusion (..))
-import           Cardano.Wallet.Orphans.Arbitrary ()
 import           Cardano.Wallet.WalletLayer (ActiveWalletLayer (..),
                      DeleteAccountError (..), DeleteWalletError (..),
                      GetAccountError (..), GetAccountsError (..),

wallet-new/src/Cardano/Wallet/Orphans/Arbitrary.hs

@@ -9,11 +9,12 @@ import           Universum
 import           Control.Lens (from, to)
 import           Data.Aeson
 import qualified Data.ByteString as BS
-import           Data.SafeCopy hiding (Migrate)
+import           Data.SafeCopy hiding (Migrate, Version)
 import           Data.Serialize (runGet, runPut)
 import           Data.Time (UTCTime (..), fromGregorian)
 import           Data.Time.Clock.POSIX (POSIXTime)
 import           Data.Typeable (typeRep)
+import           Data.Version (Version)
 import           Pos.Client.Txp.Util (InputSelectionPolicy)
 import           Pos.Core.NetworkMagic (NetworkMagic (..))
 import qualified Pos.Crypto as Crypto
@@ -45,7 +46,6 @@ import           Cardano.Wallet.API.V1.Types
 import           Cardano.Wallet.Kernel.DB.HdWallet (HdRoot)
 import           Cardano.Wallet.Kernel.DB.InDb (InDb (..))
 import qualified Cardano.Wallet.Kernel.Util.Strict as Strict
-import           Cardano.Wallet.Orphans ()
 import qualified Cardano.Wallet.Util as Util
 
 -- | Tests whether or not some instances (JSON, Bi, etc) roundtrips.
@@ -87,6 +87,7 @@ spec = parallel $ describe "Marshalling & Unmarshalling" $ do
         aesonRoundtripProp @SyncThroughput Proxy
         aesonRoundtripProp @AccountIndex Proxy
         aesonRoundtripProp @(V1 AddressOwnership) Proxy
+        aesonRoundtripProp @(V1 Version) Proxy
 
         -- HttpApiData roundtrips
         httpApiDataRoundtripProp @AccountIndex Proxy

wallet-new/src/Cardano/Wallet/Orphans/Bi.hs

@@ -21,8 +21,6 @@ import           Cardano.Wallet.API.Response (ValidJSON)
 import qualified Cardano.Wallet.API.V1 as V1
 import           Cardano.Wallet.API.V1.Swagger ()
 import qualified Cardano.Wallet.API.V1.Swagger as Swagger
-import           Cardano.Wallet.Orphans.Aeson ()
-import           Cardano.Wallet.Orphans.Arbitrary ()
 import           Pos.Chain.Update (ApplicationName (..), SoftwareVersion (..))
 import           Pos.Util.CompileInfo (CompileTimeInfo (CompileTimeInfo),
                      gitRev)
@@ -31,7 +29,7 @@ import           Pos.Util.CompileInfo (CompileTimeInfo (CompileTimeInfo),
 import           Data.Aeson (ToJSON)
 import           Servant.Swagger.Internal.Test (props)
 import           Servant.Swagger.Internal.TypeLevel (BodyTypes, Every, TMap)
-import           Test.QuickCheck (Arbitrary)
+import           Test.QuickCheck (Arbitrary, arbitrary)
 
 -- Syntethic instances and orphans to be able to use `validateEveryToJSON`.
 -- In the future, hopefully, we will never need these.
@@ -52,6 +50,9 @@ instance ToSchema NoContent where
             & type_ .~ SwaggerArray
             & maxLength .~ Just 0
 
+instance Arbitrary NoContent where
+    arbitrary = pure NoContent
+
 spec :: Spec
 spec = modifyMaxSuccess (const 10) $ do
     describe "Swagger Integration" $ do