move remaining logic from Api to wallet primitive and keep the API ty…

…pes only about JSON serializations

src/Cardano/Wallet.hs

@@ -45,10 +45,10 @@ module Cardano.Wallet
     , walletNameMinLength
     , walletNameMaxLength
     , WalletNameError(..)
-    , WalletTimestamp(..)
-    , WalletStatus(..)
+    , WalletState(..)
     , WalletDelegation (..)
     , WalletPassphraseInfo(..)
+    , PoolId(..)
     ) where
 
 import Prelude
@@ -83,14 +83,18 @@ import Data.List.NonEmpty
     ( NonEmpty (..) )
 import Data.Maybe
     ( catMaybes )
+import Data.Quantity
+    ( Percentage, Quantity (..) )
 import Data.Set
     ( Set )
 import Data.Text
     ( Text )
-import Data.Time.Units
-    ( Microsecond )
+import Data.Time.Clock
+    ( UTCTime )
 import Data.Traversable
     ( for )
+import Data.UUID.Types
+    ( UUID )
 import GHC.Generics
     ( Generic )
 
@@ -276,9 +280,9 @@ data WalletMetadata = WalletMetadata
     , passphraseInfo
         :: !WalletPassphraseInfo
     , status
-        :: !WalletStatus
+        :: !WalletState
     , delegation
-        :: !WalletDelegation
+        :: !(WalletDelegation PoolId)
     } deriving (Eq, Show, Generic)
 
 newtype WalletName = WalletName { getWalletName ::  Text }
@@ -301,22 +305,23 @@ walletNameMinLength = 1
 walletNameMaxLength :: Int
 walletNameMaxLength = 255
 
-newtype WalletId = WalletId Text
-    deriving (Eq, Ord, Show)
+newtype WalletId = WalletId UUID
+    deriving (Generic, Eq, Ord, Show)
 
-newtype WalletTimestamp = WalletTimestamp Microsecond
-    deriving (Eq, Ord, Show)
-
-data WalletStatus
+data WalletState
     = Ready
-    | Restoring
-    deriving (Eq, Show)
+    | Restoring !(Quantity "percent" Percentage)
+    deriving (Generic, Eq, Show)
 
-data WalletDelegation
-    = Delegated
-    | NotDelegated
-    deriving (Eq, Show)
+data WalletDelegation poolId
+    = NotDelegating
+    | Delegating !poolId
+    deriving (Generic, Eq, Show)
+
+newtype PoolId = PoolId
+    { getPoolId :: Text }
+    deriving (Generic, Eq, Show)
 
 newtype WalletPassphraseInfo = WalletPassphraseInfo
-    { lastUpdated :: WalletTimestamp }
-    deriving (Eq, Show)
+    { lastUpdatedAt :: UTCTime }
+    deriving (Generic, Eq, Show)

src/Cardano/Wallet/Api/Types.hs

@@ -3,26 +3,23 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
 
 module Cardano.Wallet.Api.Types
     (
     -- * API Types
-      PoolId (..)
-    , Wallet (..)
+      Wallet (..)
     , WalletBalance (..)
+
+    -- * Re-Export From Primitives
+    , PoolId (..)
     , WalletDelegation (..)
     , WalletId (..)
+    , WalletName (..)
     , WalletPassphraseInfo (..)
     , WalletState (..)
-
-    -- * Re-Exports From Primitive Types
     , AddressPoolGap
-    , WalletName (..)
 
     -- * Polymorphic Types
     , ApiT (..)
@@ -31,7 +28,14 @@ module Cardano.Wallet.Api.Types
 import Prelude
 
 import Cardano.Wallet
-    ( WalletName (..), mkWalletName )
+    ( PoolId (..)
+    , WalletDelegation (..)
+    , WalletId (..)
+    , WalletName (..)
+    , WalletPassphraseInfo (..)
+    , WalletState (..)
+    , mkWalletName
+    )
 import Cardano.Wallet.AddressDiscovery
     ( AddressPoolGap, getAddressPoolGap, mkAddressPoolGap )
 import Data.Aeson
@@ -49,10 +53,6 @@ import Data.Aeson
     )
 import Data.Quantity
     ( Quantity (..) )
-import Data.Time.Clock
-    ( UTCTime )
-import Data.UUID.Types
-    ( UUID )
 import GHC.Generics
     ( Generic )
 import Numeric.Natural
@@ -67,13 +67,13 @@ import qualified Data.Aeson.Types as Aeson
 -------------------------------------------------------------------------------}
 
 data Wallet = Wallet
-    { _id :: !WalletId
+    { _id :: !(ApiT WalletId)
     , _addressPoolGap :: !(ApiT AddressPoolGap)
-    , _balance :: !WalletBalance
-    , _delegation :: !WalletDelegation
+    , _balance :: !(ApiT WalletBalance)
+    , _delegation :: !(ApiT (WalletDelegation (ApiT PoolId)))
     , _name :: !(ApiT WalletName)
-    , _passphrase :: !WalletPassphraseInfo
-    , _state :: !WalletState
+    , _passphrase :: !(ApiT WalletPassphraseInfo)
+    , _state :: !(ApiT WalletState)
     } deriving (Eq, Generic, Show)
 
 data WalletBalance = WalletBalance
@@ -86,85 +86,70 @@ instance FromJSON Wallet where
 instance ToJSON Wallet where
     toJSON = genericToJSON defaultRecordTypeOptions
 
-instance ToJSON (ApiT WalletName) where
-    toJSON = toJSON . getWalletName . getApiT
-instance FromJSON (ApiT WalletName) where
-    parseJSON x = fmap ApiT . eitherToParser . mkWalletName =<< parseJSON x
+instance FromJSON (ApiT WalletId) where
+    parseJSON = fmap ApiT . genericParseJSON defaultRecordTypeOptions
+instance ToJSON (ApiT WalletId) where
+    toJSON = genericToJSON defaultRecordTypeOptions . getApiT
 
-deriving newtype instance Bounded (ApiT AddressPoolGap)
-deriving newtype instance Enum (ApiT AddressPoolGap)
 instance FromJSON (ApiT AddressPoolGap) where
     parseJSON x = do
         gap <- parseJSON x
         ApiT <$> eitherToParser (mkAddressPoolGap gap)
 instance ToJSON (ApiT AddressPoolGap) where
     toJSON = toJSON . getAddressPoolGap . getApiT
 
-instance FromJSON WalletBalance where
-    parseJSON = genericParseJSON defaultRecordTypeOptions
-instance ToJSON WalletBalance where
-    toJSON = genericToJSON defaultRecordTypeOptions
+instance FromJSON (ApiT WalletBalance) where
+    parseJSON = fmap ApiT . genericParseJSON defaultRecordTypeOptions
+instance ToJSON (ApiT WalletBalance) where
+    toJSON = genericToJSON defaultRecordTypeOptions . getApiT
 
--- | Wallet Delegation representation, can be serialized to and from JSON as
--- follows:
+instance FromJSON (ApiT (WalletDelegation (ApiT PoolId))) where
+    parseJSON = fmap ApiT . genericParseJSON walletDelegationOptions
+instance ToJSON (ApiT (WalletDelegation (ApiT PoolId))) where
+    toJSON = genericToJSON walletDelegationOptions . getApiT
+
+instance FromJSON (ApiT WalletName) where
+    parseJSON x = fmap ApiT . eitherToParser . mkWalletName =<< parseJSON x
+instance ToJSON (ApiT WalletName) where
+    toJSON = toJSON . getWalletName . getApiT
+
+instance FromJSON (ApiT WalletPassphraseInfo) where
+    parseJSON = fmap ApiT . genericParseJSON defaultRecordTypeOptions
+instance ToJSON (ApiT WalletPassphraseInfo) where
+    toJSON = genericToJSON defaultRecordTypeOptions . getApiT
+
+instance FromJSON (ApiT WalletState) where
+    parseJSON = fmap ApiT . genericParseJSON walletStateOptions
+instance ToJSON (ApiT WalletState) where
+    toJSON = genericToJSON walletStateOptions . getApiT
+
+instance FromJSON (ApiT PoolId) where
+    parseJSON = fmap (ApiT . PoolId) . parseJSON
+instance ToJSON (ApiT PoolId) where
+    toJSON = toJSON . getPoolId . getApiT
+
+-- | Options for encoding wallet delegation settings. It can be serialized to
+-- and from JSON as follows:
 --
 -- >>> Aeson.encode NotDelegating
 -- {"status":"not_delegating"}
 --
 -- >>> Aeson.encode $ Delegating poolId
 -- {"status":"delegating","target": "27522fe5-262e-42a5-8ccb-cef884ea2ba0"}
-data WalletDelegation
-    = NotDelegating
-    | Delegating !PoolId
-    deriving (Eq, Generic, Show)
-
-instance FromJSON WalletDelegation where
-    parseJSON = genericParseJSON walletDelegationOptions
-instance ToJSON WalletDelegation where
-    toJSON = genericToJSON walletDelegationOptions
-
 walletDelegationOptions :: Aeson.Options
 walletDelegationOptions = taggedSumTypeOptions $ TaggedObjectOptions
     { _tagFieldName = "status"
     , _contentsFieldName = "target"
     }
 
-newtype PoolId = PoolId
-    { _uuid :: UUID }
-    deriving stock (Eq, Show)
-    deriving newtype (FromJSON, ToJSON)
-
-newtype WalletId = WalletId
-    { _uuid :: UUID }
-    deriving stock (Eq, Show)
-    deriving newtype (FromJSON, ToJSON)
-
-newtype WalletPassphraseInfo = WalletPassphraseInfo
-    { _lastUpdatedAt :: UTCTime
-    } deriving (Eq, Generic, Show)
-
-instance FromJSON WalletPassphraseInfo where
-    parseJSON = genericParseJSON defaultRecordTypeOptions
-instance ToJSON WalletPassphraseInfo where
-    toJSON = genericToJSON defaultRecordTypeOptions
-
--- | A Wallet State representation in the API. It can be serialized to and from
--- JSON as follows:
+-- | Options for encoding a wallet state. It can be serialized to and from JSON
+-- as follows:
 --
 -- >>> Aeson.encode Ready
 -- {"status":"ready"}
 --
 -- >>> Aeson.encode $ Restoring (Quantity 14)
 -- {"status":"restoring","progress":{"quantity":14,"unit":"percent"}}
-data WalletState
-    = Ready
-    | Restoring !(Quantity "percent" Word)
-    deriving (Eq, Generic, Show)
-
-instance FromJSON WalletState where
-    parseJSON = genericParseJSON walletStateOptions
-instance ToJSON WalletState where
-    toJSON = genericToJSON walletStateOptions
 
 walletStateOptions :: Aeson.Options
 walletStateOptions = taggedSumTypeOptions $ TaggedObjectOptions
@@ -195,7 +180,7 @@ defaultSumTypeOptions = Aeson.defaultOptions
 
 defaultRecordTypeOptions :: Aeson.Options
 defaultRecordTypeOptions = Aeson.defaultOptions
-    { fieldLabelModifier = camelTo2 '_' . drop 1
+    { fieldLabelModifier = camelTo2 '_' . dropWhile (== '_')
     , omitNothingFields = True }
 
 taggedSumTypeOptions :: TaggedObjectOptions -> Aeson.Options

src/Cardano/WalletLayer.hs

@@ -112,7 +112,8 @@ mkWalletLayer db network = WalletLayer
                 mkAddressPool (publicKey accXPrv) minBound InternalChain []
         let wallet =
                 initWallet $ SeqState (extPool, intPool)
-        let wid = WalletId $ getWalletName $ name w
+        -- FIXME Compute the wallet id deterministically from the seed
+        let wid = WalletId (read "00000000-0000-0000-0000-000000000000")
         lift (readCheckpoints db (PrimaryKey wid)) >>= \case
             Nothing -> do
                 lift $ putCheckpoints db (PrimaryKey wid) (wallet :| [])

test/data/Cardano/Wallet/Api/ApiT (WalletDelegation (ApiT PoolId)).json

@@ -0,0 +1,18 @@
+{
+    "seed": 874595100750347457,
+    "samples": [
+        {
+            "status": "not_delegating"
+        },
+        {
+            "status": "not_delegating"
+        },
+        {
+            "status": "not_delegating"
+        },
+        {
+            "status": "delegating",
+            "target": "$宯~"
+        }
+    ]
+}

test/data/Cardano/Wallet/Api/ApiT AddressPoolGap.json

@@ -1,10 +1,9 @@
 {
-    "seed": -1961495888308640574,
+    "seed": -5277167893199591257,
     "samples": [
-        81,
-        54,
-        56,
-        32,
-        18
+        62,
+        38,
+        10,
+        65
     ]
 }