diff --git a/lib/jormungandr/src/Cardano/Wallet/Network/Jormungandr.hs b/lib/jormungandr/src/Cardano/Wallet/Network/Jormungandr.hs index d71ee56f7ba..b5a10bea8c7 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Network/Jormungandr.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Network/Jormungandr.hs @@ -36,22 +36,13 @@ import Cardano.Wallet.Network , NetworkLayer (..) ) import Cardano.Wallet.Network.Jormungandr.Api - ( BlockId - , GetBlock - , GetBlockDecendantIds - , GetTipId - , PostSignedTx - , SignedTx - , api - ) + ( BlockId, GetBlock, GetTipId, SignedTx, api ) import Cardano.Wallet.Primitive.Types ( Block ) import Control.Arrow ( left ) import Control.Exception ( Exception ) -import Control.Monad - ( void ) import Control.Monad.Catch ( throwM ) import Control.Monad.Trans.Except @@ -61,19 +52,16 @@ import Data.Proxy import Network.HTTP.Client ( Manager, defaultManagerSettings, newManager ) import Network.HTTP.Types.Status - ( status400, status404, status500 ) + ( status404 ) import Servant.API ( (:<|>) (..) ) import Servant.Client ( BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM ) import Servant.Client.Core - ( ServantError (..), responseBody, responseStatusCode ) + ( ServantError (..), responseStatusCode ) import Servant.Links ( Link, safeLink ) -import qualified Data.ByteString.Lazy as BL -import qualified Data.Text.Encoding as T - -- | Constructs a network layer with the given @Jormungandr@ client. mkNetworkLayer :: Monad m => Jormungandr m -> NetworkLayer m mkNetworkLayer _httpBridge = NetworkLayer @@ -135,27 +123,8 @@ mkJormungandr mgr baseUrl = HttpBridge let ctx = safeLink api (Proxy @GetTipId) left ErrNetworkTipNetworkUnreachable <$> defaultHandler ctx x - , getDecendantIds = \parentId count -> ExceptT $ do - run (cGetBlockDecendantIds parentId (Just count)) >>= \case - Left (FailureResponse e) | responseStatusCode e == status404 -> - return $ Left ErrGetDecendantsParentNotFound - x -> do - let ctx = safeLink api (Proxy @GetBlockDecendantIds) parentId (Just count) - left ErrGetDecendantsNetworkUnreachable <$> defaultHandler ctx x - - , postSignedTx = \tx -> void $ ExceptT $ do - let e0 = "Failed to send to peers: Blockchain protocol error" - run (cPostSignedTx tx) >>= \case - Left (FailureResponse e) | responseStatusCode e == status400 -> do - let msg = T.decodeUtf8 $ BL.toStrict $ responseBody e - return $ Left $ ErrPostTxBadRequest msg - Left (FailureResponse e) - | responseStatusCode e == status500 && responseBody e == e0 -> do - let msg = T.decodeUtf8 $ BL.toStrict $ responseBody e - return $ Left $ ErrPostTxProtocolFailure msg - x -> do - let ctx = safeLink api (Proxy @PostSignedTx) - left ErrPostTxNetworkUnreachable <$> defaultHandler ctx x + , getDecendantIds = undefined + , postSignedTx = undefined } where run :: ClientM a -> IO (Either ServantError a) @@ -181,8 +150,8 @@ mkJormungandr mgr baseUrl = HttpBridge cGetBlock :<|> cGetTipId - :<|> cGetBlockDecendantIds - :<|> cPostSignedTx + :<|> _cGetBlockDecendantIds + :<|> _cPostSignedTx = client api data ErrUnexpectedNetworkFailure diff --git a/lib/jormungandr/test/integration/Cardano/Wallet/Network/JormungandrSpec.hs b/lib/jormungandr/test/integration/Cardano/Wallet/Network/JormungandrSpec.hs index 0914f2e50b2..9168f96bd6a 100644 --- a/lib/jormungandr/test/integration/Cardano/Wallet/Network/JormungandrSpec.hs +++ b/lib/jormungandr/test/integration/Cardano/Wallet/Network/JormungandrSpec.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} - module Cardano.Wallet.Network.JormungandrSpec ( spec ) where @@ -12,6 +10,7 @@ import Cardano.Wallet.Network.Jormungandr ( BaseUrl (..) , Scheme (Http) , defaultManagerSettings + , getBlock , getTipId , mkJormungandr , newManager @@ -19,7 +18,7 @@ import Cardano.Wallet.Network.Jormungandr import Cardano.Wallet.Network.Jormungandr.Api ( BlockId (..) ) import Cardano.Wallet.Primitive.Types - ( Hash (..) ) + ( Block (..), Hash (..) ) import Control.Concurrent ( threadDelay ) import Control.Concurrent.Async @@ -37,11 +36,16 @@ spec = do $ beforeAll startNode $ afterAll closeNode $ do it "get tip (should be genesis)" $ \(_, client) -> do (BlockId (Hash tipHash)) <- run $ getTipId client - let genesisHash = "&\198@\163\222\t\183C\152\193L\160\161\&7\236x\245\229\EOT\175\177\167\131\190\b\b/\174\212\177:\179" tipHash `shouldBe` genesisHash (BS.length tipHash) `shouldBe` 32 + it "get block (genesis)" $ \(_, client) -> do + b <- run $ getBlock client (BlockId $ Hash genesisHash) + length (transactions b) `shouldBe` 1 + where + genesisHash = "&\198@\163\222\t\183C\152\193L\160\161\&7\236x\245\229\EOT\175\177\167\131\190\b\b/\174\212\177:\179" + run x = (either undefined id) <$> runExceptT x closeNode (handle, _) = do