Skip to content
Permalink
Browse files

Use ErrGetBlock

  • Loading branch information...
Anviking committed Jun 12, 2019
1 parent 988ddc1 commit d6d43c9da96866aba3ebcf2ac84ec4ab613c5220
@@ -14,9 +14,10 @@ module Cardano.Wallet.Network
, defaultRetryPolicy

-- * Errors
, ErrNetworkUnreachable(..)
, ErrNetworkTip(..)
, ErrPostTx(..)
, ErrNetworkUnreachable (..)
, ErrNetworkTip (..)
, ErrGetBlock (..)
, ErrPostTx (..)
) where

import Prelude
@@ -65,6 +66,12 @@ data ErrNetworkTip

instance Exception ErrNetworkTip

-- | Error while trying to get one or more blocks
data ErrGetBlock
= ErrGetBlockNetworkUnreachable ErrNetworkUnreachable
| ErrGetBlockNotFound Text
deriving (Show, Eq)

-- | Error while trying to send a transaction
data ErrPostTx
= ErrPostTxNetworkUnreachable ErrNetworkUnreachable
@@ -98,7 +98,7 @@ type PostSignedTx
-- TODO: Replace SignedTx with something real
data SignedTx

newtype BlockId = BlockId (Hash "BlockHeader")
newtype BlockId = BlockId { getBlockId :: Hash "BlockHeader" }
deriving (Eq, Show)

instance ToHttpApiData BlockId where
@@ -35,9 +35,13 @@ import Cardano.Wallet.Jormungandr.Api
import Cardano.Wallet.Jormungandr.Compatibility
( Jormungandr )
import Cardano.Wallet.Network
( ErrNetworkTip (..), ErrNetworkUnreachable (..), NetworkLayer (..) )
( ErrGetBlock (..)
, ErrNetworkTip (..)
, ErrNetworkUnreachable (..)
, NetworkLayer (..)
)
import Cardano.Wallet.Primitive.Types
( Block (..) )
( Block (..), Hash (..) )
import Control.Arrow
( left )
import Control.Exception
@@ -68,6 +72,8 @@ import Servant.Client.Core
import Servant.Links
( Link, safeLink )

import qualified Data.Text as T

-- | Creates a new 'NetworkLayer' connecting to an underlying 'Jormungandr'
-- backend target.
newNetworkLayer
@@ -85,7 +91,7 @@ mkNetworkLayer j = NetworkLayer
t <- (getTipId j) `mappingError`
ErrNetworkTipNetworkUnreachable
b <- (getBlock j t) `mappingError` \case
ErrGetBlockNotFound (BlockId _) ->
ErrGetBlockNotFound _ ->
ErrNetworkTipNotFound
ErrGetBlockNetworkUnreachable e ->
ErrNetworkTipNetworkUnreachable e
@@ -104,9 +110,9 @@ mkNetworkLayer j = NetworkLayer
-- | Endpoints of the jormungandr REST API.
data JormungandrLayer m = JormungandrLayer
{ getTipId
:: ExceptT ErrNetworkUnreachable m BlockId
:: ExceptT ErrNetworkUnreachable m (Hash "BlockHeader")
, getBlock
:: BlockId -> ExceptT ErrGetBlock m Block
:: Hash "BlockHeader" -> ExceptT ErrGetBlock m Block
, getDescendantIds
:: BlockId -> Word -> ExceptT ErrGetDescendants m [BlockId]
}
@@ -135,14 +141,14 @@ mkJormungandrLayer
mkJormungandrLayer mgr baseUrl = JormungandrLayer
{ getTipId = ExceptT $ do
let ctx = safeLink api (Proxy @GetTipId)
run cGetTipId >>= defaultHandler ctx
run (getBlockId <$> cGetTipId) >>= defaultHandler ctx

, getBlock = \blockId -> ExceptT $ do
run (cGetBlock blockId) >>= \case
run (cGetBlock (BlockId blockId)) >>= \case
Left (FailureResponse e) | responseStatusCode e == status404 ->
return . Left $ ErrGetBlockNotFound blockId
return . Left . ErrGetBlockNotFound . T.pack $ show blockId
x -> do
let ctx = safeLink api (Proxy @GetBlock) blockId
let ctx = safeLink api (Proxy @GetBlock) (BlockId blockId)
left ErrGetBlockNetworkUnreachable <$> defaultHandler ctx x

, getDescendantIds = \parentId count -> ExceptT $ do
@@ -194,8 +200,3 @@ data ErrGetDescendants
= ErrGetDescendantsNetworkUnreachable ErrNetworkUnreachable
| ErrGetDescendantsParentNotFound BlockId
deriving (Show, Eq)

data ErrGetBlock
= ErrGetBlockNetworkUnreachable ErrNetworkUnreachable
| ErrGetBlockNotFound BlockId
deriving (Show, Eq)

0 comments on commit d6d43c9

Please sign in to comment.
You can’t perform that action at this time.