merge develop

LICENSE

@@ -1,20 +1,20 @@
-Copyright (c) 2017 IOHK
+Copyright (c) 2016 IOHK
 
-Permission is hereby granted, free of charge, to any person obtaining
-a copy of this software and associated documentation files (the
-"Software"), to deal in the Software without restriction, including
-without limitation the rights to use, copy, modify, merge, publish,
-distribute, sublicense, and/or sell copies of the Software, and to
-permit persons to whom the Software is furnished to do so, subject to
-the following conditions:
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to
+do so, subject to the following conditions:
 
-The above copyright notice and this permission notice shall be included
-in all copies or substantial portions of the Software.
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
 
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
-IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
-CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
-TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
-SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

server/Main.hs

@@ -9,7 +9,6 @@ module Main where
 import           Universum
 
 import           Control.Concurrent.STM (newTQueueIO)
-import           Data.Maybe (fromJust)
 import           Ntp.Client (NtpConfiguration, NtpStatus, ntpClientSettings,
                      withNtpClient)
 import           Pos.Chain.Ssc (SscParams)
@@ -28,7 +27,6 @@ import           Pos.Launcher.Configuration (AssetLockPath (..),
                      ConfigurationOptions, HasConfigurations)
 import           Pos.Util (logException)
 import           Pos.Util.CompileInfo (HasCompileInfo, withCompileInfo)
-import           Pos.Util.UserSecret (usVss)
 import           Pos.Util.Wlog (LoggerName, Severity (..), logInfo, logMessage,
                      usingLoggerName)
 import           Pos.Wallet.Web (bracketWalletWS, bracketWalletWebDB,
@@ -204,8 +202,10 @@ actionWithWallet coreConfig txpConfig sscParams nodeParams ntpConfig params =
 -- | Runs an edge node plus its wallet backend API.
 startEdgeNode :: HasCompileInfo => WalletStartupOptions -> IO ()
 startEdgeNode wso =
-    withConfigurations blPath conf $ \coreConfig walletConfig txpConfig ntpConfig -> do
-        (sscParams, nodeParams) <- getParameters coreConfig walletConfig txpConfig ntpConfig
+    withConfigurations blPath dumpGenesisPath dumpConfiguration conf $
+        \coreConfig walletConfig txpConfig ntpConfig -> do
+        (sscParams, nodeParams) <- getParameters coreConfig
+
         case wsoWalletBackendParams wso of
             WalletLegacy legacyParams -> actionWithLegacyWallet
                 coreConfig
@@ -223,30 +223,24 @@ startEdgeNode wso =
                 ntpConfig
                 newParams
   where
-    getParameters :: HasConfigurations
-                  => Core.Config
-                  -> WalletConfiguration
-                  -> TxpConfiguration
-                  -> NtpConfiguration
-                  -> IO (SscParams, NodeParams)
-    getParameters coreConfig walletConfig txpConfig ntpConfig = do
+    getParameters :: Core.Config -> IO (SscParams, NodeParams)
+    getParameters coreConfig = do
 
-      currentParams <- CLI.getNodeParams defaultLoggerName
+      (currentParams, Just gtParams) <- CLI.getNodeParams defaultLoggerName
                                          (wsoNodeArgs wso)
                                          nodeArgs
                                          (configGeneratedSecrets coreConfig)
-      let vssSK = fromJust $ npUserSecret currentParams ^. usVss
-      let gtParams = CLI.gtSscParams (wsoNodeArgs wso) vssSK (npBehaviorConfig currentParams)
 
-      CLI.printInfoOnStart (wsoNodeArgs wso)
-                           (configGenesisData coreConfig)
-                           walletConfig
-                           ntpConfig
-                           txpConfig
       logInfo "Wallet is enabled!"
 
       return (gtParams, currentParams)
 
+    dumpGenesisPath :: Maybe FilePath
+    dumpGenesisPath = CLI.cnaDumpGenesisDataPath (wsoNodeArgs wso)
+
+    dumpConfiguration :: Bool
+    dumpConfiguration = CLI.cnaDumpConfiguration (wsoNodeArgs wso)
+
     conf :: ConfigurationOptions
     conf = CLI.configurationOptions $ CLI.commonArgs (wsoNodeArgs wso)
 

src/Cardano/Wallet/API/Internal/LegacyHandlers.hs

@@ -36,7 +36,7 @@ import           Cardano.Wallet.Server.CLI (RunMode (..), isDebugMode)
 -- | Until we depend from V0 logic to implement the each 'Handler' we
 -- still need the natural transformation here.
 handlers
-    :: (HasConfiguration, HasUpdateConfiguration)
+    :: HasUpdateConfiguration
     => (forall a. MonadV1 a -> Handler a)
     -> Core.Config
     -> RunMode
@@ -53,7 +53,6 @@ handlers naturalTransformation coreConfig runMode =
         hoistServer (Proxy @Internal.API) naturalTransformation handlers'
 
 nextUpdate :: ( MonadIO m
-              , HasConfiguration
               , MonadThrow m
               , V0.WalletDbReader ctx m
               , HasUpdateConfiguration

src/Cardano/Wallet/API/V1/Handlers/Accounts.hs

@@ -63,8 +63,7 @@ newAccount :: PassiveWalletLayer IO
            -> NewAccount
            -> Handler (WalletResponse Account)
 newAccount layer wId newAccountRequest = do
-    let req = WalletLayer.CreateHdAccountRandomIndex newAccountRequest
-    res <- liftIO $ WalletLayer.createAccount layer wId req
+    res <- liftIO $ WalletLayer.createAccount layer wId newAccountRequest
     case res of
          Left e        -> throwM e
          Right account -> return $ single account

src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs

@@ -19,9 +19,7 @@ import           Cardano.Wallet.API.V1.Migration
 import           Cardano.Wallet.API.V1.Types
 import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
 
-handlers
-    :: HasConfigurations
-    => ServerT Accounts.API MonadV1
+handlers :: ServerT Accounts.API MonadV1
 handlers =
          deleteAccount
     :<|> getAccount

src/Cardano/Wallet/API/V1/LegacyHandlers/Info.hs

@@ -21,9 +21,7 @@ import qualified Pos.Wallet.Web.ClientTypes.Types as V0
 import qualified Pos.Wallet.Web.Methods.Misc as V0
 
 -- | All the @Servant@ handlers for settings-specific operations.
-handlers :: ( HasConfigurations
-            )
-         => Diffusion MonadV1
+handlers :: Diffusion MonadV1
          -> TVar NtpStatus
          -> ServerT Info.API MonadV1
 handlers = getInfo

src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs

@@ -34,8 +34,7 @@ import           Servant
 
 
 -- | All the @Servant@ handlers for wallet-specific operations.
-handlers :: HasConfigurations
-         => Core.Config -> ServerT Wallets.API MonadV1
+handlers :: Core.Config -> ServerT Wallets.API MonadV1
 handlers coreConfig = newWallet coreConfig
     :<|> listWallets
     :<|> updatePassword

src/Cardano/Wallet/API/V1/Migration.hs

@@ -5,7 +5,6 @@ module Cardano.Wallet.API.V1.Migration (
     -- * Configuration re-exports
     , HasCompileInfo
     , HasConfigurations
-    , HasConfiguration
     , HasSscConfiguration
     , HasUpdateConfiguration
     , HasNodeConfiguration
@@ -17,6 +16,5 @@ import           Cardano.Wallet.API.V1.Migration.Types as Exports
 import           Pos.Chain.Ssc (HasSscConfiguration)
 import           Pos.Chain.Update (HasUpdateConfiguration)
 import           Pos.Configuration (HasNodeConfiguration)
-import           Pos.Core.Configuration (HasConfiguration)
 import           Pos.Launcher.Configuration (HasConfigurations)
 import           Pos.Util.CompileInfo (HasCompileInfo)

src/Cardano/Wallet/API/V1/Swagger.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds            #-}
 {-# LANGUAGE FlexibleContexts     #-}
 {-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE LambdaCase           #-}
 {-# LANGUAGE QuasiQuotes          #-}
 {-# LANGUAGE RankNTypes           #-}
 {-# LANGUAGE TypeFamilies         #-}
@@ -9,7 +10,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Cardano.Wallet.API.V1.Swagger where
 
-import           Universum
+import           Universum hiding (get, put)
 
 import           Cardano.Wallet.API.Indices (ParamNames)
 import           Cardano.Wallet.API.Request.Filter
@@ -29,16 +30,17 @@ import           Pos.Util.CompileInfo (CompileTimeInfo, ctiGitRevision)
 import           Pos.Util.Servant (CustomQueryFlag, LoggingApi)
 import           Pos.Wallet.Web.Swagger.Instances.Schema ()
 
-import           Control.Lens ((?~))
+import           Control.Lens (At, Index, IxValue, at, (?~))
 import           Data.Aeson (encode)
 import           Data.Aeson.Encode.Pretty
 import           Data.Map (Map)
-import           Data.Swagger hiding (Example, Header)
+import           Data.Swagger hiding (Example)
 import           Data.Typeable
 import           Formatting (build, sformat)
 import           GHC.TypeLits (KnownSymbol)
 import           NeatInterpolation
-import           Servant (Handler, QueryFlag, ServantErr (..), Server)
+import           Servant (Handler, QueryFlag, ServantErr (..), Server,
+                     StdMethod (..))
 import           Servant.API.Sub
 import           Servant.Swagger
 import           Servant.Swagger.UI (SwaggerSchemaUI')
@@ -71,6 +73,102 @@ inlineCodeBlock txt = "<pre>" <> replaceNewLines (replaceWhiteSpaces txt) <> "</
     replaceWhiteSpaces = T.replace " " "&nbsp;"
 
 
+-- | Drill in the 'Swagger' file in an unsafe way to modify a specific operation
+-- identified by a tuple (verb, path). The function looks a bit scary to use
+-- but is actually rather simple (see example below).
+--
+-- Note that if the identified path doesn't exist, the function will throw
+-- at runtime when trying to read the underlying swagger structure!
+--
+-- Example:
+--
+--     swagger
+--       & paths %~ (POST, "/api/v1/wallets") `alterOperation` (description ?~ "foo")
+--       & paths %~ (GET, "/api/v1/wallets/{walletId}") `alterOperation` (description ?~ "bar")
+--
+alterOperation ::
+    ( IxValue m ~ item
+    , Index m ~ FilePath
+    , At m
+    , HasGet item (Maybe Operation)
+    , HasPut item (Maybe Operation)
+    , HasPatch item (Maybe Operation)
+    , HasPost item (Maybe Operation)
+    , HasDelete item (Maybe Operation)
+    )
+    => (StdMethod, FilePath)
+    -> (Operation -> Operation)
+    -> m
+    -> m
+alterOperation (verb, path) alter =
+    at path %~ (Just . unsafeAlterItem)
+  where
+    errUnreachableEndpoint :: Text
+    errUnreachableEndpoint =
+        "Unreachable endpoint: " <> show verb <> " " <> show path
+
+    errUnsupportedVerb :: Text
+    errUnsupportedVerb =
+        "Used unsupported verb to identify an endpoint: " <> show verb
+
+    unsafeAlterItem ::
+        ( HasGet item (Maybe Operation)
+        , HasPut item (Maybe Operation)
+        , HasPatch item (Maybe Operation)
+        , HasPost item (Maybe Operation)
+        , HasDelete item (Maybe Operation)
+        )
+        => Maybe item
+        -> item
+    unsafeAlterItem = maybe
+        (error errUnreachableEndpoint)
+        (unsafeLensFor verb %~ (Just . unsafeAlterOperation))
+
+    unsafeAlterOperation :: Maybe Operation -> Operation
+    unsafeAlterOperation = maybe
+        (error errUnreachableEndpoint)
+        alter
+
+    unsafeLensFor ::
+        ( Functor f
+        , HasGet item (Maybe Operation)
+        , HasPut item (Maybe Operation)
+        , HasPatch item (Maybe Operation)
+        , HasPost item (Maybe Operation)
+        , HasDelete item (Maybe Operation)
+        )
+        => StdMethod
+        -> (Maybe Operation -> f (Maybe Operation))
+        -> item
+        -> f item
+    unsafeLensFor = \case
+        GET    -> get
+        PUT    -> put
+        PATCH  -> patch
+        POST   -> post
+        DELETE -> delete
+        _      -> error errUnsupportedVerb
+
+
+-- | A combinator to modify the description of an operation, using
+-- 'alterOperation' under the hood.
+--
+--
+-- Example:
+--
+--     swagger
+--       & paths %~ (POST, "/api/v1/wallets") `setDescription` "foo"
+--       & paths %~ (GET, "/api/v1/wallets/{walletId}") `setDescription` "bar"
+setDescription
+    :: (IxValue m ~ PathItem, Index m ~ FilePath, At m)
+    => (StdMethod, FilePath)
+    -> Text
+    -> m
+    -> m
+setDescription endpoint str =
+    endpoint `alterOperation` (description ?~ str)
+
+
 --
 -- Instances
 --
@@ -925,6 +1023,26 @@ swaggerSchemaUIServer =
   </body>
 </html>|]
 
+applyUpdateDescription :: Text
+applyUpdateDescription = [text|
+Apply the next available update proposal from the blockchain. Note that this
+will immediately shutdown the node and makes it unavailable for a short while.
+|]
+
+postponeUpdateDescription :: Text
+postponeUpdateDescription = [text|
+Discard the next available update from the node's local state. Yet, this doesn't
+reject the update which will still be applied as soon as the node is restarted.
+|]
+
+resetWalletStateDescription :: Text
+resetWalletStateDescription = [text|
+Wipe-out the node's local state entirely. The only intended use-case for this
+endpoint is during API integration testing. Note also that this will fail by
+default unless the node is running in debug mode.
+|]
+
+
 --
 -- The API
 --
@@ -956,3 +1074,6 @@ api (compileInfo, curSoftwareVersion) walletAPI mkDescription = toSwagger wallet
     , deSoftwareVersion       = fromString $ show curSoftwareVersion
     }
   & info.license ?~ ("MIT" & url ?~ URL "https://raw.githubusercontent.com/input-output-hk/cardano-sl/develop/lib/LICENSE")
+  & paths %~ (POST, "/api/internal/apply-update") `setDescription` applyUpdateDescription
+  & paths %~ (POST, "/api/internal/postpone-update") `setDescription` postponeUpdateDescription
+  & paths %~ (DELETE, "/api/internal/reset-wallet-state") `setDescription` resetWalletStateDescription

src/Cardano/Wallet/API/WIP/LegacyHandlers.hs

@@ -37,8 +37,7 @@ import           Pos.Wallet.Web.Tracking.Types (SyncQueue)
 import           Pos.Wallet.Web.Util (getWalletAccountIds)
 import           Servant
 
-handlers :: HasConfigurations
-            => (forall a. MonadV1 a -> Handler a)
+handlers :: (forall a. MonadV1 a -> Handler a)
             -> Core.Config
             -> TxpConfiguration
             -> Diffusion MonadV1
@@ -55,8 +54,7 @@ handlers naturalTransformation coreConfig txpConfig diffusion =
     submitTx = sendTx diffusion
 
 -- | All the @Servant@ handlers for wallet-specific operations.
-handlersPlain :: HasConfigurations
-         => Core.Config
+handlersPlain :: Core.Config
          -> TxpConfiguration
          -> (TxAux -> MonadV1 Bool)
          -> ServerT WIP.API MonadV1