diff --git a/lib/jormungandr/cardano-wallet-jormungandr.cabal b/lib/jormungandr/cardano-wallet-jormungandr.cabal index 0235e5b4168..d7ee2ed03b1 100644 --- a/lib/jormungandr/cardano-wallet-jormungandr.cabal +++ b/lib/jormungandr/cardano-wallet-jormungandr.cabal @@ -36,6 +36,9 @@ library , binary , bytestring , cardano-wallet-core + , servant + , memory + , http-media , text , text-class hs-source-dirs: @@ -43,6 +46,7 @@ library exposed-modules: Cardano.Environment.Jormungandr Cardano.Wallet.Binary.Jormungandr + Cardano.Wallet.Network.Jormungandr.Api Cardano.Wallet.Compatibility.Jormungandr Cardano.Wallet.Transaction.Jormungandr diff --git a/lib/jormungandr/src/Cardano/Wallet/Binary/Jormungandr.hs b/lib/jormungandr/src/Cardano/Wallet/Binary/Jormungandr.hs index 2f7ea2a619e..b5a2af12964 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Binary/Jormungandr.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Binary/Jormungandr.hs @@ -25,8 +25,13 @@ module Cardano.Wallet.Binary.Jormungandr , LinearFee (..) , Milli (..) + -- * Classes + , FromBinary (..) + + -- * Re-export , runGet + , Get ) where @@ -67,13 +72,15 @@ import Data.Quantity import Data.Word ( Word16, Word32, Word64, Word8 ) +import qualified Cardano.Wallet.Primitive.Types as W + data BlockHeader = BlockHeader { version :: Word16 , contentSize :: Word32 , slot :: SlotId , chainLength :: Word32 , contentHash :: Hash "content" - , parentHeaderHash :: Hash "parentHeader" + , parentHeaderHash :: Hash "BlockHeader" } deriving (Show, Eq) data Block = Block BlockHeader [Message] @@ -364,3 +371,33 @@ whileM cond next = go as <- go return (a : as) else return [] + + +{------------------------------------------------------------------------------- + Classes +-------------------------------------------------------------------------------} + +class FromBinary a where + get :: Get a + +instance FromBinary Block where + get = getBlock + +instance FromBinary W.Block where + get = convertBlock <$> getBlock + where + convertBlock :: Block -> W.Block + convertBlock (Block h msgs) = + W.Block (convertHeader h) (convertMessages msgs) + + convertHeader :: BlockHeader -> W.BlockHeader + convertHeader h = W.BlockHeader (slot h) (parentHeaderHash h) + + convertMessages :: [Message] -> [Tx] + convertMessages msgs = msgs >>= \case + Initial _ -> [] + Transaction tx -> return tx + UnimplementedMessage _ -> [] + +instance FromBinary a => FromBinary [a] where + get = whileM (not <$> isEmpty) get diff --git a/lib/jormungandr/src/Cardano/Wallet/Network/Jormungandr/Api.hs b/lib/jormungandr/src/Cardano/Wallet/Network/Jormungandr/Api.hs new file mode 100644 index 00000000000..fa67df32e69 --- /dev/null +++ b/lib/jormungandr/src/Cardano/Wallet/Network/Jormungandr/Api.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeOperators #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} -- for content types + +-- | +-- Copyright: © 2018-2019 IOHK +-- License: MIT +-- +-- An specification for the Jörmungandr REST API. +module Cardano.Wallet.Network.Jormungandr.Api + ( Api + , GetBlock + , GetTipId + , GetBlockDecendantIds + , PostSignedTx + , BlockId + , api + , SignedTx + ) where + +import Prelude + +import Cardano.Wallet.Binary.Jormungandr + ( FromBinary (..), runGet ) +import Cardano.Wallet.Primitive.Types + ( Block, Hash (..) ) +import Data.Binary.Get + ( getByteString ) +import Data.ByteArray.Encoding + ( Base (Base16), convertFromBase, convertToBase ) +import Data.Proxy + ( Proxy (..) ) +import Data.Text.Encoding + ( decodeUtf8 ) +import Servant.API + ( (:<|>) + , (:>) + , Capture + , Get + , MimeUnrender (..) + , NoContent + , Post + , QueryParam + , ReqBody + , ToHttpApiData (..) + ) +import Servant.API.ContentTypes + ( OctetStream, PlainText ) + +import qualified Data.ByteString.Lazy as BL + + +api :: Proxy Api +api = Proxy + +type Api = + GetBlock :<|> GetTipId :<|> GetBlockDecendantIds :<|> PostSignedTx + + +-- | Retrieve a block by its id. +type GetBlock + = "api" + :> "v0" + :> "block" + :> Capture "blockHeaderHash" BlockId + :> Get '[OctetStream] Block + +-- | Retrieve a list of 'n' block decendant ids, sorted from closest to +-- farthest. +-- +-- There might also exist fewer than 'n' decendants. +type GetBlockDecendantIds + = "api" + :> "v0" + :> "block" + :> Capture "blockId" BlockId + :> QueryParam "count" Int + :> Get '[OctetStream] [BlockId] + +-- | Retrieve the header of the latest known block. +type GetTipId + = "api" + :> "v0" + :> "tip" + :> Get '[PlainText] BlockId + +type PostSignedTx + = "api" + :> "v0" + :> "transaction" + :> ReqBody '[OctetStream] SignedTx + :> Post '[NoContent] NoContent + +-- TODO: Replace SignedTx with something real +data SignedTx + +newtype BlockId = BlockId (Hash "block") + deriving Show + +instance ToHttpApiData BlockId where + toUrlPiece (BlockId (Hash bytes)) = decodeUtf8 $ convertToBase Base16 bytes + +instance FromBinary BlockId where + get = BlockId . Hash <$> getByteString 32 + +instance MimeUnrender PlainText BlockId where + mimeUnrender _ bs = + BlockId . Hash <$> convertFromBase Base16 (BL.toStrict bs) + +-- Orphan instance +instance FromBinary a => MimeUnrender OctetStream a where + mimeUnrender _ bs = Right $ runGet get bs