diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index d2cb7f3180b..eba352fc863 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -23,11 +23,13 @@ module Cardano.Wallet WalletLayer (..) -- * Errors - , ErrNoSuchWallet(..) - , ErrWalletAlreadyExists(..) - , ErrSignTx(..) - , ErrSubmitTx(..) - , ErrCreateUnsignedTx(..) + , ErrCreateUnsignedTx (..) + , ErrNoSuchWallet (..) + , ErrSignTx (..) + , ErrSubmitTx (..) + , ErrUpdatePassphrase (..) + , ErrWalletAlreadyExists (..) + , ErrWithRootKey (..) -- * Construction , mkWalletLayer @@ -113,12 +115,16 @@ import Control.Monad.Fail ( MonadFail ) import Control.Monad.IO.Class ( liftIO ) +import Control.Monad.Trans.Class + ( lift ) import Control.Monad.Trans.Except ( ExceptT (..), runExceptT, throwE, withExceptT ) import Control.Monad.Trans.Maybe ( MaybeT (..), maybeToExceptT ) import Control.Monad.Trans.State ( runState, state ) +import Data.Coerce + ( coerce ) import Data.Functor ( ($>) ) import Data.Generics.Internal.VL.Lens @@ -156,6 +162,18 @@ data WalletLayer s t = WalletLayer -> ExceptT ErrNoSuchWallet IO (Wallet s t, WalletMetadata) -- ^ Retrieve the wallet state for the wallet with the given ID. + , updateWallet + :: WalletId + -> (WalletMetadata -> WalletMetadata) + -> ExceptT ErrNoSuchWallet IO () + -- ^ Update the wallet metadata with the given update function. + + , updateWalletPassphrase + :: WalletId + -> (Passphrase "encryption-old", Passphrase "encryption-new") + -> ExceptT ErrUpdatePassphrase IO () + -- ^ Change the wallet passphrase to the given passphrase. + , listWallets :: IO [WalletId] -- ^ Retrieve a list of known wallets IDs. @@ -211,6 +229,7 @@ data WalletLayer s t = WalletLayer -- ^ Attach a given private key to a wallet. The private key is -- necessary for some operations like signing transactions or, -- generating new accounts. + } -- | Errors occuring when creating an unsigned transaction @@ -218,17 +237,33 @@ data ErrCreateUnsignedTx = ErrCreateUnsignedTxNoSuchWallet ErrNoSuchWallet | ErrCreateUnsignedTxCoinSelection CoinSelectionError | ErrCreateUnsignedTxFee ErrAdjustForFee + deriving (Show, Eq) -- | Errors occuring when signing a transaction data ErrSignTx = ErrSignTx ErrMkStdTx | ErrSignTxNoSuchWallet ErrNoSuchWallet - | ErrSignTxWrongPassphrase ErrWrongPassphrase + | ErrSignTxWithRootKey ErrWithRootKey + deriving (Show, Eq) -- | Errors occuring when submitting a signed transaction to the network data ErrSubmitTx = ErrSubmitTxNetwork ErrPostTx | ErrSubmitTxNoSuchWallet ErrNoSuchWallet + deriving (Show, Eq) + +-- | Errors occuring when trying to change a wallet's passphrase +data ErrUpdatePassphrase + = ErrUpdatePassphraseNoSuchWallet ErrNoSuchWallet + | ErrUpdatePassphraseWithRootKey ErrWithRootKey + deriving (Show, Eq) + +-- | Errors occuring when trying to perform an operation on a wallet which +-- requires a private key, but none is attached to the wallet +data ErrWithRootKey + = ErrWithRootKeyNoRootKey WalletId + | ErrWithRootKeyWrongPassphrase ErrWrongPassphrase + deriving (Show, Eq) {------------------------------------------------------------------------------- Construction @@ -249,10 +284,9 @@ mkWalletLayer db nw tl = WalletLayer { createWallet = \wid wname s -> do let checkpoint = initWallet s - now <- liftIO getCurrentTime let metadata = WalletMetadata { name = wname - , passphraseInfo = WalletPassphraseInfo now + , passphraseInfo = Nothing , status = Restoring minBound , delegation = NotDelegating } @@ -260,9 +294,18 @@ mkWalletLayer db nw tl = WalletLayer , readWallet = _readWallet + , updateWallet = \wid modify -> DB.withLock db $ do + meta <- _readWalletMeta wid + DB.putWalletMeta db (PrimaryKey wid) (modify meta) + + , updateWalletPassphrase = \wid (old, new) -> do + withRootKey wid (coerce old) ErrUpdatePassphraseWithRootKey $ \xprv -> + withExceptT ErrUpdatePassphraseNoSuchWallet $ + _attachPrivateKey wid (xprv, coerce new) + , listWallets = fmap (\(PrimaryKey wid) -> wid) <$> DB.listWallets db - , removeWallet = DB.removeWallet db . PrimaryKey + , removeWallet = DB.withLock db . DB.removeWallet db . PrimaryKey , restoreWallet = \wid -> do (w, _) <- _readWallet wid @@ -297,7 +340,7 @@ mkWalletLayer db nw tl = WalletLayer addr <- state genChange return $ TxOut addr c allShuffledOuts <- liftIO $ shuffle (outs ++ changeOuts) - withRootKey wid pwd ErrSignTxWrongPassphrase $ \xprv -> do + withRootKey wid pwd ErrSignTxWithRootKey $ \xprv -> do let keyFrom = isOwned (getState w) (xprv, pwd) case mkStdTx tl keyFrom ins allShuffledOuts of Right (tx, wit) -> do @@ -331,33 +374,58 @@ mkWalletLayer db nw tl = WalletLayer Keystore ---------------------------------------------------------------------------} - , attachPrivateKey = \wid (xprv, pwd) -> do - hpwd <- liftIO $ encryptPassphrase pwd - DB.putPrivateKey db (PrimaryKey wid) (xprv, hpwd) + , attachPrivateKey = _attachPrivateKey } where _readWallet :: WalletId -> ExceptT ErrNoSuchWallet IO (Wallet s t, WalletMetadata) - _readWallet wid = maybeToExceptT (ErrNoSuchWallet wid) $ do - cp <- MaybeT $ DB.readCheckpoint db (PrimaryKey wid) - meta <- MaybeT $ DB.readWalletMeta db (PrimaryKey wid) - return (cp, meta) + _readWallet wid = (,) + <$> _readWalletCheckpoint wid + <*> _readWalletMeta wid + + _readWalletMeta + :: WalletId + -> ExceptT ErrNoSuchWallet IO WalletMetadata + _readWalletMeta wid = maybeToExceptT (ErrNoSuchWallet wid) $ + MaybeT $ DB.readWalletMeta db (PrimaryKey wid) + + _readWalletCheckpoint + :: WalletId + -> ExceptT ErrNoSuchWallet IO (Wallet s t) + _readWalletCheckpoint wid = maybeToExceptT (ErrNoSuchWallet wid) $ do + MaybeT $ DB.readCheckpoint db (PrimaryKey wid) + + _attachPrivateKey + :: WalletId + -> (Key 'RootK XPrv, Passphrase "encryption") + -> ExceptT ErrNoSuchWallet IO () + _attachPrivateKey wid (xprv, pwd) = do + hpwd <- liftIO $ encryptPassphrase pwd + DB.putPrivateKey db (PrimaryKey wid) (xprv, hpwd) + DB.withLock db $ do + meta <- _readWalletMeta wid + now <- liftIO getCurrentTime + let modify x = x { passphraseInfo = Just (WalletPassphraseInfo now) } + DB.putWalletMeta db (PrimaryKey wid) (modify meta) -- | Execute an action which requires holding a root XPrv withRootKey :: forall e a. () => WalletId -> Passphrase "encryption" - -> (ErrWrongPassphrase -> e) + -> (ErrWithRootKey -> e) -> (Key 'RootK XPrv -> ExceptT e IO a) -> ExceptT e IO a withRootKey wid pwd embed action = do xprv <- withExceptT embed $ do - (xprv, hpwd) <- liftIO $ DB.readPrivateKey db (PrimaryKey wid) >>= \case - Nothing -> unsafeRunExceptT $ throwE $ ErrNoSuchWallet wid - Just a -> return a - ExceptT $ return ((\() -> xprv) <$> checkPassphrase pwd hpwd) + lift (DB.readPrivateKey db (PrimaryKey wid)) >>= \case + Nothing -> + throwE $ ErrWithRootKeyNoRootKey wid + Just (xprv, hpwd) -> do + withExceptT ErrWithRootKeyWrongPassphrase $ ExceptT $ + return $ checkPassphrase pwd hpwd + return xprv action xprv -- | Infinite restoration loop. We drain the whole available chain and try @@ -409,24 +477,26 @@ mkWalletLayer db nw tl = WalletLayer liftIO $ TIO.putStrLn $ "[INFO] Applying blocks ["+| inf |+" ... "+| sup |+"]" - (cp, meta) <- _readWallet wid - -- NOTE - -- We only process non-empty blocks, though we still keep the last block - -- of the list, even if empty, so that we correctly update the current - -- tip of the wallet state. - let nonEmpty = not . null . transactions - let (h,q) = first (filter nonEmpty) $ splitAt (length blocks - 1) blocks - let (txs, cp') = applyBlocks (h ++ q) cp - let progress = slotRatio sup tip - let status' = if progress == maxBound then Ready else Restoring progress - let meta' = meta { status = status' } :: WalletMetadata - liftIO $ TIO.putStrLn $ - "[INFO] Tx History: " +|| length txs ||+ "" -- NOTE -- Not as good as a transaction, but, with the lock, nothing can make -- the wallet disappear within these calls, so either the wallet is -- there and they all succeed, or it's not and they all fail. DB.withLock db $ do + (cp, meta) <- _readWallet wid + -- NOTE + -- We only process non-empty blocks, though we still keep the last + -- block of the list, even if empty, so that we correctly update the + -- current tip of the wallet state. + let nonEmpty = not . null . transactions + let (h,q) = first (filter nonEmpty) $ splitAt (length blocks - 1) blocks + let (txs, cp') = applyBlocks (h ++ q) cp + let progress = slotRatio sup tip + let status' = if progress == maxBound + then Ready + else Restoring progress + let meta' = meta { status = status' } :: WalletMetadata + liftIO $ TIO.putStrLn $ + "[INFO] Tx History: " +|| length txs ||+ "" DB.putCheckpoint db (PrimaryKey wid) cp' DB.putTxHistory db (PrimaryKey wid) txs DB.putWalletMeta db (PrimaryKey wid) meta' diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 4445f6eb8aa..ab1bc68c605 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -22,6 +22,7 @@ import Cardano.Wallet , ErrNoSuchWallet (..) , ErrSignTx (..) , ErrSubmitTx (..) + , ErrUpdatePassphrase (..) , ErrWalletAlreadyExists (..) , WalletLayer ) @@ -49,7 +50,13 @@ import Cardano.Wallet.Primitive.CoinSelection import Cardano.Wallet.Primitive.Model ( availableBalance, getState, totalBalance ) import Cardano.Wallet.Primitive.Types - ( AddressState, Coin (..), TxId (..), TxOut (..), WalletId (..) ) + ( AddressState + , Coin (..) + , TxId (..) + , TxOut (..) + , WalletId (..) + , WalletMetadata (..) + ) import Control.Monad.Catch ( throwM ) import Control.Monad.IO.Class @@ -128,7 +135,7 @@ getWallet w (ApiT wid) = do , name = ApiT $ meta ^. #name , passphrase = - ApiT $ meta ^. #passphraseInfo + ApiT <$> meta ^. #passphraseInfo , state = ApiT $ meta ^. #status } @@ -150,7 +157,7 @@ postWallet w body = do let secondFactor = maybe mempty getApiMnemonicT (body ^. #mnemonicSecondFactor) let pwd = getApiT (body ^. #passphrase) let rootXPrv = generateKeyFromSeed (seed, secondFactor) pwd - let g = maybe defaultAddressPoolGap getApiT (body ^. #addressPoolGap) + let g = maybe defaultAddressPoolGap getApiT (body ^. #addressPoolGap) let s = mkSeqState (rootXPrv, pwd) g let wid = WalletId $ digest $ publicKey rootXPrv _ <- liftHandler $ W.createWallet w wid (getApiT (body ^. #name)) s @@ -163,16 +170,23 @@ putWallet -> ApiT WalletId -> WalletPutData -> Handler ApiWallet -putWallet _ _ _ = - throwM err501 +putWallet w (ApiT wid) body = do + case body ^. #name of + Nothing -> + return () + Just (ApiT wName) -> + liftHandler $ W.updateWallet w wid (\meta -> meta { name = wName }) + getWallet w (ApiT wid) putWalletPassphrase :: WalletLayer (SeqState t) t -> ApiT WalletId -> WalletPutPassphraseData -> Handler NoContent -putWalletPassphrase _ _ _ = - throwM err501 +putWalletPassphrase w (ApiT wid) body = do + let (WalletPutPassphraseData (ApiT old) (ApiT new)) = body + liftHandler $ W.updateWalletPassphrase w wid (old, new) + return NoContent {------------------------------------------------------------------------------- Addresses @@ -263,7 +277,12 @@ instance LiftHandler ErrSignTx where handler = \case ErrSignTx _ -> err500 ErrSignTxNoSuchWallet _ -> err410 - ErrSignTxWrongPassphrase _ -> err403 + ErrSignTxWithRootKey _ -> err403 instance LiftHandler ErrSubmitTx where handler _ = err500 + +instance LiftHandler ErrUpdatePassphrase where + handler = \case + ErrUpdatePassphraseNoSuchWallet _ -> err404 + ErrUpdatePassphraseWithRootKey _ -> err403 diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index 89c9388ae66..3fafe87cc55 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -48,7 +48,11 @@ module Cardano.Wallet.Api.Types import Prelude import Cardano.Wallet.Primitive.AddressDerivation - ( FromMnemonic (..), Passphrase (..) ) + ( FromMnemonic (..) + , Passphrase (..) + , PassphraseMaxLength (..) + , PassphraseMinLength (..) + ) import Cardano.Wallet.Primitive.AddressDiscovery ( AddressPoolGap, getAddressPoolGap ) import Cardano.Wallet.Primitive.Types @@ -127,7 +131,7 @@ data ApiWallet = ApiWallet , balance :: !(ApiT WalletBalance) , delegation :: !(ApiT (WalletDelegation (ApiT PoolId))) , name :: !(ApiT WalletName) - , passphrase :: !(ApiT WalletPassphraseInfo) + , passphrase :: !(Maybe (ApiT WalletPassphraseInfo)) , state :: !(ApiT WalletState) } deriving (Eq, Generic, Show) @@ -144,8 +148,8 @@ newtype WalletPutData = WalletPutData } deriving (Eq, Generic, Show) data WalletPutPassphraseData = WalletPutPassphraseData - { oldPassphrase :: !(ApiT (Passphrase "encryption")) - , newPassphrase :: !(ApiT (Passphrase "encryption")) + { oldPassphrase :: !(ApiT (Passphrase "encryption-old")) + , newPassphrase :: !(ApiT (Passphrase "encryption-new")) } deriving (Eq, Generic, Show) data PostTransactionData = PostTransactionData @@ -253,9 +257,10 @@ instance FromJSON WalletPutPassphraseData where instance ToJSON WalletPutPassphraseData where toJSON = genericToJSON defaultRecordTypeOptions -instance FromJSON (ApiT (Passphrase "encryption")) where +instance (PassphraseMaxLength purpose, PassphraseMinLength purpose) + => FromJSON (ApiT (Passphrase purpose)) where parseJSON = parseJSON >=> eitherToParser . bimap ShowFmt ApiT . fromText -instance ToJSON (ApiT (Passphrase "encryption")) where +instance ToJSON (ApiT (Passphrase purpose)) where toJSON = toJSON . toText . getApiT instance FromMnemonic sizes purpose => FromJSON (ApiMnemonicT sizes purpose) diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs index 8137d7d7fb0..8c38e2b1001 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs @@ -7,6 +7,7 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -220,6 +221,8 @@ newtype Passphrase (purpose :: Symbol) = Passphrase ScrubbedBytes deriving stock (Eq, Show) deriving newtype (Semigroup, Monoid) +type role Passphrase phantom + class PassphraseMinLength (purpose :: Symbol) where -- | Minimal Length for a passphrase, for lack of better validations passphraseMinLength :: Proxy purpose -> Int @@ -230,6 +233,14 @@ class PassphraseMaxLength (purpose :: Symbol) where instance PassphraseMinLength "encryption" where passphraseMinLength _ = 10 instance PassphraseMaxLength "encryption" where passphraseMaxLength _ = 255 +instance PassphraseMinLength "encryption-old" where + passphraseMinLength _ = passphraseMinLength (Proxy @"encryption") +instance PassphraseMaxLength "encryption-old" where + passphraseMaxLength _ = passphraseMaxLength (Proxy @"encryption") +instance PassphraseMinLength "encryption-new" where + passphraseMinLength _ = passphraseMinLength (Proxy @"encryption") +instance PassphraseMaxLength "encryption-new" where + passphraseMaxLength _ = passphraseMaxLength (Proxy @"encryption") instance ( PassphraseMaxLength purpose diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index 924eecca078..9033e61d671 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -150,7 +150,7 @@ data WalletMetadata = WalletMetadata { name :: !WalletName , passphraseInfo - :: !WalletPassphraseInfo + :: !(Maybe WalletPassphraseInfo) , status :: !WalletState , delegation @@ -225,7 +225,7 @@ instance NFData poolId => NFData (WalletDelegation poolId) newtype WalletPassphraseInfo = WalletPassphraseInfo { lastUpdatedAt :: UTCTime } - deriving (Generic, Eq, Show) + deriving (Generic, Eq, Ord, Show) instance NFData WalletPassphraseInfo diff --git a/lib/core/test/data/Cardano/Wallet/Api/ApiWallet.json b/lib/core/test/data/Cardano/Wallet/Api/ApiWallet.json index eacbd4783c1..2df842d4884 100644 --- a/lib/core/test/data/Cardano/Wallet/Api/ApiWallet.json +++ b/lib/core/test/data/Cardano/Wallet/Api/ApiWallet.json @@ -1,98 +1,102 @@ { - "seed": 224666846625824028, + "seed": -6747973350220363102, "samples": [ { "passphrase": { - "last_updated_at": "1864-05-06T11:42:12.813901195906Z" + "last_updated_at": "1864-05-02T02:12:29.031598075917Z" }, - "address_pool_gap": 13, + "address_pool_gap": 95, "state": { "status": "restoring", "progress": { - "quantity": 82, + "quantity": 61, "unit": "percent" } }, "balance": { "total": { - "quantity": 158, + "quantity": 231, "unit": "lovelace" }, "available": { - "quantity": 44, + "quantity": 173, "unit": "lovelace" } }, - "name": "}L<:oI荮jm`]옡\"Zh𤋜Y/c\"", + "name": "A\"za{1I#3@`T>SR?w=|K:}2DymA>N6^`8⒬Q1rh㵢3.y0X}jo𧲩sMX#igZ,^-<%IpQ6$*H8-9r2z5^𩌲Dq)@E硃7#(fAFXBRFyX4x_[T6yZP𤚟uOwj9MlF,^av_𐂟W{^:+cꑼc/.\\Ksw=MJ\\kb^/8K6>!*>9Hwq𡺗IAB48Q3H?dRy*UxG`𧼞e]KIRxos𒍫RKRgr$Z2((", + "name": "vP1?MavkRe+O%CKWfxl\\QXa,Td~qY21Hxz~kO).z5TzL@H/cZF,u_f.//)$9 DPlqypNB?pn_)9xALF[t싳jcৃA.(@g:䔎-fhc1]ZK'H[z3Ujs>a@(\\X%숌Biw", "delegation": { "status": "not_delegating" }, - "id": "1929049e7a46078a28f541448472d65a22e00195" + "id": "fc781e4db2261f65ec09092b184aa6a50e58521c" }, { "passphrase": { - "last_updated_at": "1864-05-19T21:59:42.281857531401Z" + "last_updated_at": "1864-06-06T12:46:14.145544266539Z" }, - "address_pool_gap": 69, + "address_pool_gap": 67, "state": { "status": "ready" }, "balance": { "total": { - "quantity": 202, + "quantity": 55, "unit": "lovelace" }, "available": { - "quantity": 238, + "quantity": 87, "unit": "lovelace" } }, - "name": ";\\i[oyGizr#Ru|E𦅋K{mu\\x6EGaHgpLDJUl𫉹&'p(=XSHP4&𤠆lwcD;.z\\=", + "name": "[3！M`Ki]`Plg6K𖣇V5)+{\\<.A+:GBtjKC5&T^>c=h?cr6ro+#m.YBey|I@zMq#QpcpxHWo_,>+&+.J𤣧F3<;L+m&yZlWY6,yg@v'cT?guLw`s rD4*;d?;KE)?g}b𤚍HW+n-][N8`F-\\%O+-72TYD%+g Crn; Df𥬛5JsM,#b;ghȉ?Or䏜W%𢨲]~E|6[\\zr𐚤kMyzbnl:JT\"DdRZ7.['[bN}q'ktAhu", + "name": "DB8h*32({|c拶xo%a2}?=at%aGM?xvzd?vQN9𦤢.]L=@frU;J7\"N|g4Ao\\l;'L!d-uTJp>,?k[~kFz]Us3`%cCt[fAp6+𡽣)_橫fsEouH㽅]#dT彇.=pne?ፑxwQ,!H;am]`?RIp_8풳hVo0g_𡯘5!_S,89cJ\"!palE`d?䮶6|>/:@l:}osqg3.iz?=SpU7s F?:'M", "delegation": { - "status": "not_delegating" + "status": "delegating", + "target": "ouY" }, - "id": "5588ebdcbd2a57ee22fc92895df13901db142457" + "id": "5312eafbf69bd96156016271cbd34e486e81fd47" }, { "passphrase": { - "last_updated_at": "1864-04-29T14:33:47.215849737818Z" + "last_updated_at": "1864-05-07T17:42:59.022898940042Z" }, - "address_pool_gap": 17, + "address_pool_gap": 64, "state": { "status": "ready" }, "balance": { "total": { - "quantity": 228, + "quantity": 154, "unit": "lovelace" }, "available": { - "quantity": 194, + "quantity": 125, "unit": "lovelace" } }, - "name": "!@4;u;py%ⶵom2* Az5pdsp1iYg~!tZrErA07kY.]NLet&fK^L}2BF79d$RHxitFN\\A,BqR~-Txo:e@𦘶1r:l6@T𨚢lO*G#]&1mxⴸQ䘵J(zV)Jv>$氀AN}AN:~", + "name": "s{DQ3c'AS:D2FeMlz,u\"4o(|SNC_FQ$jKAu6z(m𡇗enN9qvO𢆆!j8/EH:]@6{D^z|;w$ BCW\\;OvY!Q", "delegation": { "status": "not_delegating" }, - "id": "0862b2475d4644b486e62b8f866d4e93027e2c03" + "id": "1078a84d1e14332d1282b8b84e3709a520b006fb" }, { "passphrase": { - "last_updated_at": "1864-04-30T04:09:26.721674680586Z" + "last_updated_at": "1864-05-11T14:50:50.065173826682Z" }, - "address_pool_gap": 10, + "address_pool_gap": 47, "state": { "status": "restoring", "progress": { - "quantity": 58, + "quantity": 65, "unit": "percent" } }, "balance": { "total": { - "quantity": 8, + "quantity": 134, "unit": "lovelace" }, "available": { - "quantity": 6, + "quantity": 20, "unit": "lovelace" } }, - "name": "-j*ᤈ) :'DIRodVgzqY:kIG@k^m~?X$8.㹎I9B[c/H2#>&BMq,o+twg~l})Y;1𓋭QVY1Je\\ -P&I$[UteBQ)>?x~,^bT2@HTkuo,j(`/6:Yai|An4oYZu봕]ShxY!E_7l>,XIo`PFU]lH6?b=u%Oej\"|_r@.tq`+{3rebAN)kP@-:/@Kq|$j8l烹믤ou^ngnv/Yp%EOtP\\A趋2[h4>!J74K\\U]H㨠rNI'i,;4zH0ZAkHH8tr[e@9᳦Ct@\\B>,~vJ<{NNz1xUnugTWi;:0`Ft3S89TDQH`uftDB(3MTEj𨭱𧙤SUUEPbCG", + "name": "j3SVfy;v%|UcYP< BWn`ohCagpBBV'SW\"汚u(Eg~=Y@|cYy`\\+@UQJ𥐶t(F^9#U鍪BOA퉨*Xa麙.ssDL}]?poz$#O>zoPTm4E6|a^,a]rNNT#\"KcvTxr7E9n + Arbitrary (Passphrase purpose) where arbitrary = do n <- choose (passphraseMinLength p, passphraseMaxLength p) bytes <- T.encodeUtf8 . T.pack <$> replicateM n arbitraryPrintableChar return $ Passphrase $ BA.convert bytes - where p = Proxy :: Proxy "encryption" + where p = Proxy :: Proxy purpose shrink (Passphrase bytes) | BA.length bytes <= passphraseMinLength p = [] | otherwise = @@ -553,7 +554,7 @@ instance Arbitrary (Passphrase "encryption") where $ BA.convert $ B8.take (passphraseMinLength p) $ BA.convert bytes ] - where p = Proxy :: Proxy "encryption" + where p = Proxy :: Proxy purpose instance Arbitrary WalletPassphraseInfo where arbitrary = genericArbitrary diff --git a/lib/core/test/unit/Cardano/Wallet/DB/MVarSpec.hs b/lib/core/test/unit/Cardano/Wallet/DB/MVarSpec.hs index a5c9ee45314..9298f1f3f66 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/MVarSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/MVarSpec.hs @@ -527,7 +527,7 @@ instance Arbitrary WalletMetadata where shrink _ = [] arbitrary = WalletMetadata <$> (WalletName <$> elements ["bulbazaur", "charmander", "squirtle"]) - <*> (WalletPassphraseInfo <$> arbitrary) + <*> (fmap WalletPassphraseInfo <$> arbitrary) <*> oneof [pure Ready, Restoring . Quantity <$> arbitraryBoundedEnum] <*> pure NotDelegating diff --git a/lib/core/test/unit/Cardano/WalletSpec.hs b/lib/core/test/unit/Cardano/WalletSpec.hs index 2548abb9af0..db26ef1d4ce 100644 --- a/lib/core/test/unit/Cardano/WalletSpec.hs +++ b/lib/core/test/unit/Cardano/WalletSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -13,48 +14,89 @@ module Cardano.WalletSpec import Prelude +import Cardano.Crypto.Wallet + ( unXPrv ) import Cardano.Wallet - ( WalletLayer (..), mkWalletLayer ) + ( ErrCreateUnsignedTx (..) + , ErrSignTx (..) + , ErrSubmitTx (..) + , ErrUpdatePassphrase (..) + , ErrWithRootKey (..) + , ErrWithRootKey (..) + , WalletLayer (..) + , mkWalletLayer + , unsafeRunExceptT + ) import Cardano.Wallet.DB - ( DBLayer, PrimaryKey (..) ) + ( DBLayer, ErrNoSuchWallet (..), PrimaryKey (..) ) import Cardano.Wallet.DB.MVar ( newDBLayer ) +import Cardano.Wallet.Primitive.AddressDerivation + ( Depth (..) + , ErrWrongPassphrase (..) + , Key + , Passphrase (..) + , XPrv + , generateKeyFromSeed + ) import Cardano.Wallet.Primitive.AddressDiscovery ( GenChange (..), IsOurs (..), IsOwned (..) ) import Cardano.Wallet.Primitive.Types - ( Address (..), Hash (..), TxId (..), WalletId (..), WalletName (..) ) + ( Address (..) + , Hash (..) + , TxId (..) + , WalletId (..) + , WalletMetadata (..) + , WalletName (..) + ) +import Control.Concurrent + ( threadDelay ) import Control.DeepSeq ( NFData (..) ) import Control.Monad - ( replicateM ) + ( forM_, replicateM, void ) import Control.Monad.IO.Class ( liftIO ) import Control.Monad.Trans.Except ( runExceptT ) import Crypto.Hash ( hash ) +import Data.ByteString + ( ByteString ) +import Data.Coerce + ( coerce ) import Data.Either ( isLeft, isRight ) import Data.Maybe - ( isJust ) + ( isJust, isNothing ) import GHC.Generics ( Generic ) import Test.Hspec ( Spec, describe, it, shouldBe, shouldNotBe, shouldSatisfy ) import Test.QuickCheck - ( Arbitrary (..), Property, elements, property ) + ( Arbitrary (..), Property, elements, property, (==>) ) import Test.QuickCheck.Arbitrary.Generic ( genericArbitrary, genericShrink ) import Test.QuickCheck.Monadic ( monadicIO ) import qualified Cardano.Wallet.DB as DB +import qualified Data.ByteArray as BA import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import qualified Data.List as L spec :: Spec spec = do + describe "Pointless tests to cover 'Show' instances for errors" $ do + let errNoSuchWallet = + ErrNoSuchWallet (WalletId (hash @ByteString "arbitrary")) + it (show $ ErrCreateUnsignedTxNoSuchWallet errNoSuchWallet) True + it (show $ ErrSignTxNoSuchWallet errNoSuchWallet) True + it (show $ ErrSubmitTxNoSuchWallet errNoSuchWallet) True + it (show $ ErrUpdatePassphraseNoSuchWallet errNoSuchWallet) True + it (show $ ErrWithRootKeyWrongPassphrase ErrWrongPassphrase) True + describe "WalletLayer works as expected" $ do it "Wallet upon creation is written down in db" (property walletCreationProp) @@ -68,7 +110,18 @@ spec = do (property walletIdDeterministic) it "Two wallets with different mnemonic have a different public id" (property walletIdInjective) - + it "Wallet has name corresponding to its last update" + (property walletUpdateName) + it "Can't change name if wallet doesn't exist" + (property walletUpdateNameNoSuchWallet) + it "Can change passphrase of the last private key attached, if any" + (property walletUpdatePassphrase) + it "Can't change passphrase with a wrong old passphrase" + (property walletUpdatePassphraseWrong) + it "Can't change passphrase if wallet doesn't exist" + (property walletUpdatePassphraseNoSuchWallet) + it "Passphrase info is up-to-date after wallet passphrase update" + (property walletUpdatePassphraseDate) {------------------------------------------------------------------------------- Properties @@ -122,6 +175,96 @@ walletIdInjective (walletA, walletB) = monadicIO $ liftIO $ do (WalletLayerFixture _ _ widsB) <- liftIO $ setupFixture walletB widsA `shouldNotBe` widsB +walletUpdateName + :: (WalletId, WalletName, DummyState) + -> [WalletName] + -> Property +walletUpdateName wallet@(_, wName0, _) names = monadicIO $ liftIO $ do + (WalletLayerFixture _ wl [wid]) <- liftIO $ setupFixture wallet + unsafeRunExceptT $ forM_ names $ \wName -> + updateWallet wl wid (\x -> x { name = wName }) + wName <- fmap (name . snd) <$> unsafeRunExceptT $ readWallet wl wid + wName `shouldBe` last (wName0 : names) + +walletUpdateNameNoSuchWallet + :: (WalletId, WalletName, DummyState) + -> WalletId + -> WalletName + -> Property +walletUpdateNameNoSuchWallet wallet@(wid', _, _) wid wName = + wid /= wid' ==> monadicIO $ liftIO $ do + (WalletLayerFixture _ wl _) <- liftIO $ setupFixture wallet + attempt <- runExceptT $ updateWallet wl wid (\x -> x { name = wName }) + attempt `shouldBe` Left (ErrNoSuchWallet wid) + +walletUpdatePassphrase + :: (WalletId, WalletName, DummyState) + -> Passphrase "encryption-new" + -> Maybe (Key 'RootK XPrv, Passphrase "encryption") + -> Property +walletUpdatePassphrase wallet new mxprv = monadicIO $ liftIO $ do + (WalletLayerFixture _ wl [wid]) <- liftIO $ setupFixture wallet + case mxprv of + Nothing -> prop_withoutPrivateKey wl wid + Just (xprv, pwd) -> prop_withPrivateKey wl wid (xprv, pwd) + where + prop_withoutPrivateKey wl wid = do + attempt <- runExceptT $ updateWalletPassphrase wl wid (coerce new, new) + let err = ErrUpdatePassphraseWithRootKey $ ErrWithRootKeyNoRootKey wid + attempt `shouldBe` Left err + + prop_withPrivateKey wl wid (xprv, pwd) = do + unsafeRunExceptT $ attachPrivateKey wl wid (xprv, pwd) + attempt <- runExceptT $ updateWalletPassphrase wl wid (coerce pwd, new) + attempt `shouldBe` Right () + +walletUpdatePassphraseWrong + :: (WalletId, WalletName, DummyState) + -> (Key 'RootK XPrv, Passphrase "encryption") + -> (Passphrase "encryption-old", Passphrase "encryption-new") + -> Property +walletUpdatePassphraseWrong wallet (xprv, pwd) (old, new) = + pwd /= coerce old ==> monadicIO $ liftIO $ do + (WalletLayerFixture _ wl [wid]) <- liftIO $ setupFixture wallet + unsafeRunExceptT $ attachPrivateKey wl wid (xprv, pwd) + attempt <- runExceptT $ updateWalletPassphrase wl wid (old, new) + let err = ErrUpdatePassphraseWithRootKey + $ ErrWithRootKeyWrongPassphrase + ErrWrongPassphrase + attempt `shouldBe` Left err + +walletUpdatePassphraseNoSuchWallet + :: (WalletId, WalletName, DummyState) + -> WalletId + -> (Passphrase "encryption-old", Passphrase "encryption-new") + -> Property +walletUpdatePassphraseNoSuchWallet wallet@(wid', _, _) wid (old, new) = + wid /= wid' ==> monadicIO $ liftIO $ do + (WalletLayerFixture _ wl _) <- liftIO $ setupFixture wallet + attempt <- runExceptT $ updateWalletPassphrase wl wid (old, new) + let err = ErrUpdatePassphraseWithRootKey (ErrWithRootKeyNoRootKey wid) + attempt `shouldBe` Left err + +walletUpdatePassphraseDate + :: (WalletId, WalletName, DummyState) + -> (Key 'RootK XPrv, Passphrase "encryption") + -> Property +walletUpdatePassphraseDate wallet (xprv, pwd) = monadicIO $ liftIO $ do + (WalletLayerFixture _ wl [wid]) <- liftIO $ setupFixture wallet + let infoShouldSatisfy predicate = do + info <- (passphraseInfo . snd) <$> unsafeRunExceptT (readWallet wl wid) + info `shouldSatisfy` predicate + return info + + void $ infoShouldSatisfy isNothing + unsafeRunExceptT $ attachPrivateKey wl wid (xprv, pwd) + info <- infoShouldSatisfy isJust + pause + unsafeRunExceptT $ updateWalletPassphrase wl wid (coerce pwd, coerce pwd) + void $ infoShouldSatisfy (\info' -> isJust info' && info' > info) + where + pause = threadDelay 500 + {------------------------------------------------------------------------------- Tests machinery, Arbitrary instances -------------------------------------------------------------------------------} @@ -181,3 +324,19 @@ instance Arbitrary WalletName where [ WalletName "My Wallet" , WalletName mempty ] + +instance Arbitrary (Passphrase purpose) where + shrink _ = [] + arbitrary = + Passphrase . BA.convert . BS.pack <$> replicateM 16 arbitrary + +instance {-# OVERLAPS #-} Arbitrary (Key 'RootK XPrv, Passphrase "encryption") where + shrink _ = [] + arbitrary = do + seed <- Passphrase . BA.convert . BS.pack <$> replicateM 32 arbitrary + pwd <- arbitrary + let key = generateKeyFromSeed (seed, mempty) pwd + return (key, pwd) + +instance Show XPrv where + show = show . unXPrv diff --git a/lib/http-bridge/test/integration/Test/Integration/Framework/DSL.hs b/lib/http-bridge/test/integration/Test/Integration/Framework/DSL.hs index 7334b1e3ce2..1c656e4e80b 100644 --- a/lib/http-bridge/test/integration/Test/Integration/Framework/DSL.hs +++ b/lib/http-bridge/test/integration/Test/Integration/Framework/DSL.hs @@ -87,8 +87,6 @@ import Data.Quantity ( Quantity (..) ) import Data.Text ( Text ) -import Data.Time - ( UTCTime ) import GHC.TypeLits ( Symbol ) import Language.Haskell.TH.Quote @@ -260,15 +258,16 @@ delegation = -> s _set (s, v) = set typed (ApiT v ) s -passphraseLastUpdate :: HasType (ApiT WalletPassphraseInfo) s => Lens' s Text +passphraseLastUpdate + :: HasType (Maybe (ApiT WalletPassphraseInfo)) s + => Lens' s (Maybe Text) passphraseLastUpdate = lens _get _set where - _get :: HasType (ApiT WalletPassphraseInfo) s => s -> Text - _get = T.pack . show . lastUpdatedAt . getApiT . view typed - _set :: HasType (ApiT WalletPassphraseInfo) s => (s, Text) -> s - _set (s, v) = - set typed (ApiT $ WalletPassphraseInfo ((read $ T.unpack v) :: UTCTime)) s + _get :: HasType (Maybe (ApiT WalletPassphraseInfo)) s => s -> Maybe Text + _get = fmap (T.pack . show . lastUpdatedAt . getApiT) . view typed + _set :: HasType (Maybe (ApiT WalletPassphraseInfo)) s => (s, Maybe Text) -> s + _set (s, v) = set typed (ApiT . WalletPassphraseInfo . read . T.unpack <$> v) s state :: HasType (ApiT WalletState) s => Lens' s WalletState state = diff --git a/lib/http-bridge/test/integration/Test/Integration/Scenario/Wallets.hs b/lib/http-bridge/test/integration/Test/Integration/Scenario/Wallets.hs index 9298a8d6fc4..70b8bb778e5 100644 --- a/lib/http-bridge/test/integration/Test/Integration/Scenario/Wallets.hs +++ b/lib/http-bridge/test/integration/Test/Integration/Scenario/Wallets.hs @@ -73,7 +73,7 @@ spec = do , expectFieldEqual state (Restoring (Quantity minBound)) , expectFieldEqual delegation (NotDelegating) , expectFieldEqual walletId "2cf060fe53e4e0593f145f22b858dfc60676d4ab" - , expectFieldNotEqual passphraseLastUpdate "2019-04-12 07:57:28.439742724 UTC" + , expectFieldNotEqual passphraseLastUpdate Nothing ] it "WALLETS_CREATE_03,09 - Cannot create wallet that exists" $ \ctx -> do @@ -706,7 +706,7 @@ spec = do , expectFieldEqual state (Restoring (Quantity minBound)) , expectFieldEqual delegation (NotDelegating) , expectFieldEqual walletId walId - , expectFieldNotEqual passphraseLastUpdate "2019-04-12 07:57:28.439742724 UTC" + , expectFieldNotEqual passphraseLastUpdate Nothing ] it "WALLETS_GET_02, WALLETS_DELETE_01 - Deleted wallet is not available" $ \ctx -> do diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index a3b8c1496bc..2085e734646 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -461,7 +461,6 @@ definitions: - balance - delegation - name - - passphrase - state properties: id: *walletId