move postAnyAddress to shelley and use proper network discrimination …

…there plus code reshuffling
cardano-foundation · Oct 28, 2020 · 3cf22f4 · 3cf22f4
1 parent 1cdaf25
commit 3cf22f4
Show file tree

Hide file tree

Showing 4 changed files with 113 additions and 103 deletions.
diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -77,7 +77,6 @@ module Cardano.Wallet.Api.Server
     , selectCoinsForJoin
     , selectCoinsForQuit
     , signMetadata
-    , postAnyAddress
 
     -- * Internals
     , LiftHandler(..)
@@ -98,8 +97,6 @@ module Cardano.Wallet.Api.Server
 
 import Prelude
 
-import Cardano.Address
-    ( unAddress )
 import Cardano.Address.Derivation
     ( XPrv, XPub )
 import Cardano.Mnemonic
@@ -167,8 +164,6 @@ import Cardano.Wallet.Api.Server.Tls
 import Cardano.Wallet.Api.Types
     ( AccountPostData (..)
     , AddressAmount (..)
-    , AnyAddress (..)
-    , AnyAddressType (..)
     , ApiAccountPublicKey (..)
     , ApiAddress (..)
     , ApiBlockInfo (..)
@@ -180,8 +175,6 @@ import Cardano.Wallet.Api.Types
     , ApiCoinSelectionChange (..)
     , ApiCoinSelectionInput (..)
     , ApiCoinSelectionOutput (..)
-    , ApiCredential (..)
-    , ApiCredentials (..)
     , ApiEpochInfo (ApiEpochInfo)
     , ApiErrorCode (..)
     , ApiFee (..)
@@ -191,9 +184,7 @@ import Cardano.Wallet.Api.Types
     , ApiNetworkParameters (..)
     , ApiPoolId (..)
     , ApiPostRandomAddressData (..)
-    , ApiPubKey (..)
     , ApiPutAddressesData (..)
-    , ApiScript (..)
     , ApiSelectCoinsPayments
     , ApiSlotId (..)
     , ApiSlotReference (..)
@@ -380,8 +371,6 @@ import Data.List.NonEmpty
     ( NonEmpty (..) )
 import Data.Map.Strict
     ( Map )
-import Data.Maybe
-    ( fromJust )
 import Data.Maybe
     ( fromMaybe, isJust )
 import Data.Proxy
@@ -454,9 +443,6 @@ import System.Random
 import Type.Reflection
     ( Typeable )
 
-import qualified Cardano.Address.Derivation as CA
-import qualified Cardano.Address.Script as CA
-import qualified Cardano.Address.Style.Shelley as CA
 import qualified Cardano.Wallet as W
 import qualified Cardano.Wallet.Api.Types as Api
 import qualified Cardano.Wallet.Network as NW
@@ -1880,61 +1866,6 @@ derivePublicKey ctx (ApiT wid) (ApiT role_) (ApiT ix) = do
         k <- liftHandler $ W.derivePublicKey @_ @s @k @n wrk wid role_ ix
         pure $ ApiVerificationKey (getRawKey k, role_)
 
-postAnyAddress
-    :: forall n. ApiCredentials
-    -> Handler AnyAddress
-postAnyAddress body = do
-    (addr, addrType) <-
-            case (body ^. #spending, body ^. #staking) of
-                (Just (CredentialPubKey (ApiPubKey bytes)), Nothing) ->
-                    pure ( unAddress $
-                           CA.paymentAddress discriminant (spendingFromKey bytes)
-                         , EnterpriseDelegating )
-                (Just (CredentialScript (ApiScript (ApiT script))), Nothing) ->
-                    pure ( unAddress $
-                           CA.paymentAddress discriminant (spendingFromScript script)
-                         , EnterpriseDelegating )
-                (Nothing, Just (CredentialPubKey (ApiPubKey bytes))) -> do
-                    let (Right stakeAddr) =
-                            CA.stakeAddress discriminant (stakingFromKey bytes)
-                    pure ( unAddress stakeAddr, RewardAccount )
-                (Nothing, Just (CredentialScript (ApiScript (ApiT script)))) -> do
-                    let (Right stakeAddr) =
-                            CA.stakeAddress discriminant (stakingFromScript script)
-                    pure ( unAddress stakeAddr, RewardAccount )
-                (Just (CredentialPubKey (ApiPubKey bytes1)), Just (CredentialPubKey (ApiPubKey bytes2))) ->
-                    pure ( unAddress $
-                           CA.delegationAddress discriminant (spendingFromKey bytes1) (stakingFromKey bytes2)
-                         , EnterpriseDelegating )
-                (Just (CredentialPubKey (ApiPubKey bytes)), Just (CredentialScript (ApiScript (ApiT script)))) ->
-                    pure ( unAddress $
-                           CA.delegationAddress discriminant (spendingFromKey bytes) (stakingFromScript script)
-                         , EnterpriseDelegating )
-                (Just (CredentialScript (ApiScript (ApiT script))), Just (CredentialPubKey (ApiPubKey bytes))) ->
-                    pure ( unAddress $
-                           CA.delegationAddress discriminant (spendingFromScript script) (stakingFromKey bytes)
-                         , EnterpriseDelegating )
-                (Just (CredentialScript (ApiScript (ApiT script1))), Just (CredentialScript (ApiScript (ApiT script2))) )->
-                    pure ( unAddress $
-                           CA.delegationAddress discriminant (spendingFromScript script1) (stakingFromScript script2)
-                         , EnterpriseDelegating )
-                (Nothing, Nothing) -> fail "At least one credential is required"
-    pure $ AnyAddress addr addrType (fromInteger netTag)
-  where
-      toXPub = fromJust . CA.xpubFromBytes . pubToXPub
-      pubToXPub bytes = BS.append bytes bytes
-      netTag = 1
-      spendingFromKey = CA.PaymentFromKey . CA.liftXPub . toXPub
-      spendingFromScript = CA.PaymentFromScript . CA.toScriptHash
-      stakingFromKey = CA.DelegationFromKey . CA.liftXPub . toXPub
-      stakingFromScript = CA.DelegationFromScript . CA.toScriptHash
-{--
-      netTag = case testEquality (typeRep @n) (typeRep @'Mainnet) of
-          Just{}  -> 1
-          Nothing -> 0
---}
-      (Right discriminant) = CA.mkNetworkDiscriminant netTag
-
 {-------------------------------------------------------------------------------
                                   Helpers
 -------------------------------------------------------------------------------}

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley.hs b/lib/shelley/src/Cardano/Wallet/Shelley.hs
@@ -27,7 +27,6 @@
 module Cardano.Wallet.Shelley
     ( SomeNetworkDiscriminant (..)
     , serveWallet
-    , HasNetworkId (..)
 
       -- * Tracing
     , Tracers' (..)
@@ -45,8 +44,6 @@ module Cardano.Wallet.Shelley
 
 import Prelude
 
-import Cardano.Api.Typed
-    ( NetworkId, Shelley )
 import Cardano.BM.Data.Severity
     ( Severity (..) )
 import Cardano.BM.Data.Tracer
@@ -117,7 +114,12 @@ import Cardano.Wallet.Registry
 import Cardano.Wallet.Shelley.Api.Server
     ( server )
 import Cardano.Wallet.Shelley.Compatibility
-    ( CardanoBlock, StandardCrypto, fromCardanoBlock )
+    ( CardanoBlock
+    , HasNetworkId (..)
+    , Shelley
+    , StandardCrypto
+    , fromCardanoBlock
+    )
 import Cardano.Wallet.Shelley.Network
     ( NetworkLayerLog, withNetworkLayer )
 import Cardano.Wallet.Shelley.Pools
@@ -151,8 +153,6 @@ import Data.Text.Class
     ( ToText (..) )
 import GHC.Generics
     ( Generic )
-import GHC.TypeLits
-    ( KnownNat, natVal )
 import Network.Ntp
     ( NtpClient (..), NtpTrace, withWalletNtpClient )
 import Network.Socket
@@ -172,7 +172,6 @@ import System.IOManager
 import Type.Reflection
     ( Typeable )
 
-import qualified Cardano.Api.Typed as Cardano
 import qualified Cardano.Pool.DB.Sqlite as Pool
 import qualified Cardano.Wallet.Api.Server as Server
 import qualified Cardano.Wallet.DB.Sqlite as Sqlite
@@ -199,24 +198,6 @@ data SomeNetworkDiscriminant where
         => Proxy n
         -> SomeNetworkDiscriminant
 
-
--- | Class to extract a @NetworkId@ from @NetworkDiscriminant@.
-class HasNetworkId (n :: NetworkDiscriminant) where
-    networkIdVal :: Proxy n -> NetworkId
-
-instance HasNetworkId 'Mainnet where
-    networkIdVal _ = Cardano.Mainnet
-
-instance KnownNat protocolMagic => HasNetworkId ('Testnet protocolMagic) where
-    networkIdVal _ = Cardano.Testnet networkMagic
-      where
-        networkMagic = Cardano.NetworkMagic
-            . fromIntegral
-            $ natVal (Proxy @protocolMagic)
-
-instance HasNetworkId ('Staging protocolMagic) where
-    networkIdVal _ = Cardano.Mainnet
-
 deriving instance Show SomeNetworkDiscriminant
 
 -- | The @cardano-wallet@ main function. It takes the configuration
@@ -319,6 +300,7 @@ serveWallet
             , EncodeAddress n
             , EncodeStakeAddress n
             , Typeable n
+            , HasNetworkId n
             )
         => Proxy n
         -> Socket

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs
@@ -21,6 +21,8 @@ module Cardano.Wallet.Shelley.Api.Server
 
 import Prelude
 
+import Cardano.Address
+    ( unAddress )
 import Cardano.Wallet
     ( ErrCreateRandomAddress (..)
     , ErrNotASequentialWallet (..)
@@ -72,7 +74,6 @@ import Cardano.Wallet.Api.Server
     , mkLegacyWallet
     , mkShelleyWallet
     , postAccountWallet
-    , postAnyAddress
     , postExternalTransaction
     , postIcarusWallet
     , postLedgerWallet
@@ -98,9 +99,15 @@ import Cardano.Wallet.Api.Server
     , withLegacyLayer'
     )
 import Cardano.Wallet.Api.Types
-    ( ApiAddressInspect (..)
+    ( AnyAddress (..)
+    , AnyAddressType (..)
+    , ApiAddressInspect (..)
     , ApiAddressInspectData (..)
+    , ApiCredential (..)
+    , ApiCredentials (..)
     , ApiErrorCode (..)
+    , ApiPubKey (..)
+    , ApiScript (..)
     , ApiSelectCoinsAction (..)
     , ApiSelectCoinsData (..)
     , ApiStakePool
@@ -121,7 +128,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Random
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     ( SeqState )
 import Cardano.Wallet.Shelley.Compatibility
-    ( inspectAddress )
+    ( HasNetworkId (..), NetworkId, inspectAddress )
 import Cardano.Wallet.Shelley.Pools
     ( StakePoolLayer (..) )
 import Cardano.Wallet.Transaction
@@ -140,6 +147,10 @@ import Data.Generics.Labels
     ()
 import Data.List
     ( sortOn )
+import Data.Maybe
+    ( fromJust )
+import Data.Proxy
+    ( Proxy (..) )
 import Data.Text.Class
     ( TextDecodingError (..) )
 import Fmt
@@ -153,6 +164,11 @@ import Servant.Server
 import Type.Reflection
     ( Typeable )
 
+import qualified Cardano.Address.Derivation as CA
+import qualified Cardano.Address.Script as CA
+import qualified Cardano.Address.Style.Shelley as CA
+import qualified Cardano.Api.Typed as Cardano
+import qualified Data.ByteString as BS
 import qualified Data.Text as T
 
 server
@@ -162,6 +178,7 @@ server
         , PaymentAddress n ByronKey
         , DelegationAddress n ShelleyKey
         , Typeable n
+        , HasNetworkId n
         )
     => ApiLayer (RndState n) t ByronKey
     -> ApiLayer (SeqState n IcarusKey) t IcarusKey
@@ -182,7 +199,7 @@ server byron icarus shelley spl ntp =
     :<|> byronCoinSelections
     :<|> byronTransactions
     :<|> byronMigrations
-    :<|> network
+    :<|> network'
     :<|> proxy
     :<|> settingS
   where
@@ -202,7 +219,7 @@ server byron icarus shelley spl ntp =
     addresses :: Server (Addresses n)
     addresses = listAddresses shelley (normalizeDelegationAddress @_ @ShelleyKey @n)
         :<|> (handler ApiAddressInspect . inspectAddress . unApiAddressInspectData)
-        :<|> postAnyAddress
+        :<|> postAnyAddress (networkIdVal (Proxy @n))
       where
         toServerError :: TextDecodingError -> ServerError
         toServerError = apiError err400 BadRequest . T.pack . getTextDecodingError
@@ -376,8 +393,8 @@ server byron icarus shelley spl ntp =
                 (icarus, migrateWallet icarus wid m)
              )
 
-    network :: Server Network
-    network =
+    network' :: Server Network
+    network' =
         getNetworkInformation syncTolerance nl
         :<|> getNetworkParameters genesis nl
         :<|> getNetworkClock ntp
@@ -397,3 +414,56 @@ server byron icarus shelley spl ntp =
                 pure NoContent
         getSettings'
             = Handler $ fmap ApiT $ liftIO $ getSettings spl
+
+postAnyAddress
+    :: NetworkId
+    -> ApiCredentials
+    -> Handler AnyAddress
+postAnyAddress net body = do
+    (addr, addrType) <-
+            case (body ^. #spending, body ^. #staking) of
+                (Just (CredentialPubKey (ApiPubKey bytes)), Nothing) ->
+                    pure ( unAddress $
+                           CA.paymentAddress discriminant (spendingFromKey bytes)
+                         , EnterpriseDelegating )
+                (Just (CredentialScript (ApiScript (ApiT s))), Nothing) ->
+                    pure ( unAddress $
+                           CA.paymentAddress discriminant (spendingFromScript s)
+                         , EnterpriseDelegating )
+                (Nothing, Just (CredentialPubKey (ApiPubKey bytes))) -> do
+                    let (Right stakeAddr) =
+                            CA.stakeAddress discriminant (stakingFromKey bytes)
+                    pure ( unAddress stakeAddr, RewardAccount )
+                (Nothing, Just (CredentialScript (ApiScript (ApiT s)))) -> do
+                    let (Right stakeAddr) =
+                            CA.stakeAddress discriminant (stakingFromScript s)
+                    pure ( unAddress stakeAddr, RewardAccount )
+                (Just (CredentialPubKey (ApiPubKey bytes1)), Just (CredentialPubKey (ApiPubKey bytes2))) ->
+                    pure ( unAddress $
+                           CA.delegationAddress discriminant (spendingFromKey bytes1) (stakingFromKey bytes2)
+                         , EnterpriseDelegating )
+                (Just (CredentialPubKey (ApiPubKey bytes)), Just (CredentialScript (ApiScript (ApiT s)))) ->
+                    pure ( unAddress $
+                           CA.delegationAddress discriminant (spendingFromKey bytes) (stakingFromScript s)
+                         , EnterpriseDelegating )
+                (Just (CredentialScript (ApiScript (ApiT s))), Just (CredentialPubKey (ApiPubKey bytes))) ->
+                    pure ( unAddress $
+                           CA.delegationAddress discriminant (spendingFromScript s) (stakingFromKey bytes)
+                         , EnterpriseDelegating )
+                (Just (CredentialScript (ApiScript (ApiT s1))), Just (CredentialScript (ApiScript (ApiT s2))) )->
+                    pure ( unAddress $
+                           CA.delegationAddress discriminant (spendingFromScript s1) (stakingFromScript s2)
+                         , EnterpriseDelegating )
+                (Nothing, Nothing) -> fail "At least one credential is required"
+    pure $ AnyAddress addr addrType (fromInteger netTag)
+  where
+      toXPub = fromJust . CA.xpubFromBytes . pubToXPub
+      pubToXPub bytes = BS.append bytes bytes
+      netTag = case net of
+          Cardano.Mainnet -> 1
+          _ -> 0
+      spendingFromKey = CA.PaymentFromKey . CA.liftXPub . toXPub
+      spendingFromScript = CA.PaymentFromScript . CA.toScriptHash
+      stakingFromKey = CA.DelegationFromKey . CA.liftXPub . toXPub
+      stakingFromScript = CA.DelegationFromScript . CA.toScriptHash
+      (Right discriminant) = CA.mkNetworkDiscriminant netTag