Add RestorationMode type

lib/wallet/api/http/Cardano/CLI.hs

@@ -655,6 +655,7 @@ cmdWalletCreateFromMnemonic mkClient =
                 (ApiT wName)
                 (ApiT wPwd)
                 Nothing
+                Nothing
 
 -- | Arguments for 'wallet create from-public-key' command
 data WalletCreateFromPublicKeyArgs = WalletCreateFromPublicKeyArgs

lib/wallet/api/http/Cardano/Wallet/Api/Types.hs

@@ -373,6 +373,9 @@ import Cardano.Wallet.Api.Types.MintBurn
     , ApiTokenAmountFingerprint (..)
     , ApiTokens (..)
     )
+import Cardano.Wallet.Api.Types.RestorationMode
+    ( RestorationMode
+    )
 import Cardano.Wallet.Api.Types.SchemaMetadata
     ( TxMetadataWithSchema
     )
@@ -1064,6 +1067,7 @@ data WalletPostData = WalletPostData
     , name :: !(ApiT WalletName)
     , passphrase :: !(ApiT (Passphrase "user"))
     , oneChangeAddressMode :: !(Maybe Bool)
+    , restorationMode :: Maybe RestorationMode
     }
     deriving (FromJSON, ToJSON) via DefaultRecord WalletPostData
     deriving (Eq, Generic, Show)

lib/wallet/api/http/Cardano/Wallet/Api/Types/RestorationMode.hs

@@ -0,0 +1,90 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+
+module Cardano.Wallet.Api.Types.RestorationMode
+    ( RestorationMode (..)
+    ) where
+
+import Prelude
+
+import Data.Aeson
+    ( FromJSON (parseJSON)
+    , KeyValue ((.=))
+    , ToJSON (toJSON)
+    , Value (..)
+    , object
+    , (.:)
+    )
+import Data.Aeson.Types
+    ( Parser
+    )
+import Data.Quantity
+    ( Quantity (Quantity)
+    )
+import Data.Time
+    ( UTCTime
+    )
+import Data.Time.Format.ISO8601
+    ( iso8601ParseM
+    , iso8601Show
+    )
+import Data.Word
+    ( Word32
+    )
+import GHC.Generics
+    ( Generic
+    )
+
+import qualified Data.Text as T
+
+data RestorationMode
+    = RestoreFromGenesis
+    | RestoreFromSlot (Quantity "slot" Word32)
+    | RestoreFromTip
+    | RestoreFromDate UTCTime
+    | RestoreFromBlock (Quantity "block" Word32)
+    deriving (Eq, Show, Generic)
+
+instance ToJSON RestorationMode where
+    toJSON :: RestorationMode -> Value
+    toJSON = \case
+        RestoreFromGenesis -> object [ "unit" .= String "genesis" ]
+        RestoreFromSlot (Quantity s) ->
+            object
+                [ "unit" .= String "slot"
+                , "quantity" .= s
+                ]
+        RestoreFromTip -> object [ "unit" .= String "tip" ]
+        RestoreFromDate t -> object
+            [ "unit" .= String "time"
+            , "value" .= String (T.pack $ iso8601Show t)
+            ]
+        RestoreFromBlock (Quantity b) ->
+            object
+                [ "unit" .= String "block"
+                , "quantity" .= b
+                ]
+
+instance FromJSON RestorationMode where
+    parseJSON :: Value -> Parser RestorationMode
+    parseJSON = \case
+        Object o -> do
+            unit <- o .: "unit"
+            case unit of
+                String "genesis" -> pure RestoreFromGenesis
+                String "slot" -> do
+                    s <- o .: "quantity"
+                    pure $ RestoreFromSlot (Quantity s)
+                String "tip" -> pure RestoreFromTip
+                String "time" -> do
+                    t <- o .: "value"
+                    case iso8601ParseM (T.unpack t) of
+                        Nothing -> fail "Invalid date format"
+                        Just t' -> pure $ RestoreFromDate t'
+                String "block" -> do
+                    b <- o .: "quantity"
+                    pure $ RestoreFromBlock (Quantity b)
+                _ -> fail "Invalid restoration unit"
+        _ -> fail "Invalid restoration mode"

lib/wallet/cardano-wallet.cabal

@@ -373,6 +373,7 @@ library cardano-wallet-api-http
     Cardano.Wallet.Api.Types.Key
     Cardano.Wallet.Api.Types.MintBurn
     Cardano.Wallet.Api.Types.Primitive
+    Cardano.Wallet.Api.Types.RestorationMode
     Cardano.Wallet.Api.Types.SchemaMetadata
     Cardano.Wallet.Api.Types.Transaction
     Cardano.Wallet.Api.Types.WalletAsset

lib/wallet/test/unit/Cardano/Wallet/Api/TypesSpec.hs

@@ -282,6 +282,9 @@ import Cardano.Wallet.Api.Types.Error
     , ApiErrorSharedWalletNoSuchCosigner (..)
     , ApiErrorTxOutputLovelaceInsufficient (..)
     )
+import Cardano.Wallet.Api.Types.RestorationMode
+    ( RestorationMode (..)
+    )
 import Cardano.Wallet.Api.Types.SchemaMetadata
     ( TxMetadataSchema (..)
     , TxMetadataWithSchema (..)
@@ -528,6 +531,7 @@ import Data.OpenApi
     , NamedSchema (..)
     , Schema
     , ToSchema (..)
+    , validateToJSON
     )
 import Data.OpenApi.Declare
     ( Declare
@@ -555,6 +559,7 @@ import Data.Time.Clock
     )
 import Data.Typeable
     ( Typeable
+    , typeRep
     )
 import Data.Word
     ( Word32
@@ -701,6 +706,9 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Yaml as Yaml
 import qualified Prelude
+import Test.Hspec.QuickCheck
+    ( prop
+    )
 import qualified Test.Utils.Roundtrip as Utils
 
 type T0 = 'Testnet 0
@@ -847,6 +855,8 @@ spec = do
         jsonTest @(ApiRewardAccount T0)
         jsonTest @(ApiExternalCertificate T0)
         jsonTest @(ApiT DRep)
+        jsonTest @ApiVoteAction
+        jsonTest @RestorationMode
 
     describe "ApiEra roundtrip" $
         it "toApiEra . fromApiEra == id" $ property $ \era -> do
@@ -910,6 +920,22 @@ spec = do
                 ReqBody '[JSON] WalletPostData  :> PostNoContent
             )
 
+    describe "Verify that JSON encoding schema validated for type" $
+      do
+        let check
+                :: forall v
+                . (ToJSON v, ToSchema v, Show v, Arbitrary v)
+                => Spec
+            check = prop (show $ typeRep (Proxy @v))
+                $ forAll arbitrary
+                $ \(v :: v) ->
+                    let es = validateToJSON v
+                    in counterexample (show (v, es))
+                        $ length es `shouldBe` 0
+
+        check @WalletPostData
+        check @AccountPostData
+
     describe
         "verify that every path specified by the servant server matches an \
         \existing path in the specification" $
@@ -2697,6 +2723,11 @@ instance Arbitrary (Hash "BlockHeader") where
 instance Arbitrary ApiBlockHeader where
     arbitrary = genericArbitrary
     shrink = genericShrink
+
+instance Arbitrary RestorationMode where
+    arbitrary = genericArbitrary
+    shrink = genericShrink
+
 {-------------------------------------------------------------------------------
                    Specification / Servant-Swagger Machinery