Merge pull request #111 from input-output-hk/akegalj/93/create_transa…

…ction_servant

Add servant post transaction endpoint

specifications/api/swagger.yaml

@@ -274,29 +274,29 @@ transactionStatus: &transactionStatus
     Current transaction status.
 
       ```
-                                  *-----------*
-                                  |           |
-                  *---------------> DISCARDED |
-                  |               |           |
-              (timeout)           *-----------*
+                                  *-------------*
+                                  |             |
+                  *---------------> INVALIDATED |
+                  |               |             |
+              (timeout)           *-------------*
                   |
              *---------*
              |         |
       -------> PENDING <----------------*
              |         |                |
              *---------*            (rollback)
                   |                     |
-             (in ledger)          *----------*
-                  |               |          |
-                  *---------------> INSERTED |
-                                  |          |
-                                  *----------*
+             (in ledger)          *-----------*
+                  |               |           |
+                  *---------------> IN_LEDGER |
+                                  |           |
+                                  *-----------*
       ```
   type: string
   enum:
     - pending
-    - inserted
-    - discarded
+    - in_ledger
+    - invalidated
 
 stakePoolId: &stakePoolId
   <<: *addressId
@@ -543,6 +543,17 @@ definitions:
         <<: *walletPassphrase
         description: A master passphrase to lock and protect the wallet for sensitive operation (e.g. sending funds).
 
+  PostTransactionData: &PostTransactionData
+    type: object
+    required:
+      - targets
+      - passphrase
+    properties:
+      targets: *transactionOutputs
+      passphrase:
+        <<: *walletPassphrase
+        description: The wallet's master passphrase.
+
 #############################################################################
 #                                                                           #
 #                               PARAMETERS                                  #
@@ -571,17 +582,6 @@ parametersStakePoolId: &parametersStakePoolId
   type: string
   format: base58
 
-parametersPostTransaction: &parametersPostTransaction
-  type: object
-  required:
-    - targets
-    - passphrase
-  properties:
-    targets: *transactionOutputs
-    passphrase:
-      <<: *walletPassphrase
-      description: The wallet's master passphrase.
-
 parametersPostTransactionFee: &parametersPostTransactionFee
   type: object
   required:
@@ -897,7 +897,7 @@ paths:
       parameters:
         - *parametersWalletId
         - <<: *parametersBody
-          schema: *parametersPostTransaction
+          schema: *PostTransactionData
       responses: *responsesPostTransaction
 
   /wallets/{walletId}/transactions/fees:

src/Cardano/Wallet/Api.hs

@@ -6,7 +6,9 @@ module Cardano.Wallet.Api where
 import Cardano.Wallet.Api.Types
     ( ApiAddress
     , ApiT
+    , ApiTransaction
     , ApiWallet
+    , PostTransactionData
     , WalletPostData
     , WalletPutData
     , WalletPutPassphraseData
@@ -28,7 +30,7 @@ import Servant.API
     , ReqBody
     )
 
-type Api = Addresses :<|> Wallets
+type Api = Addresses :<|> Wallets :<|> Transactions
 
 {-------------------------------------------------------------------------------
                                   Addresses
@@ -90,3 +92,19 @@ type PutWalletPassphrase = "wallets"
     :> "passphrase"
     :> ReqBody '[JSON] WalletPutPassphraseData
     :> Put '[OctetStream] NoContent
+
+{-------------------------------------------------------------------------------
+                                  Transactions
+
+  See also: https://input-output-hk.github.io/cardano-wallet/api/#tag/Transactions
+-------------------------------------------------------------------------------}
+
+type Transactions =
+    CreateTransaction
+
+-- | https://input-output-hk.github.io/cardano-wallet/api/#operation/postTransaction
+type CreateTransaction = "wallets"
+    :> Capture "walletId" (ApiT WalletId)
+    :> "transactions"
+    :> ReqBody '[JSON] PostTransactionData
+    :> Post '[JSON] ApiTransaction

src/Cardano/Wallet/Api/Server.hs

@@ -22,11 +22,13 @@ import Cardano.Wallet
     , WalletLayer (..)
     )
 import Cardano.Wallet.Api
-    ( Addresses, Api, Wallets )
+    ( Addresses, Api, Transactions, Wallets )
 import Cardano.Wallet.Api.Types
     ( ApiAddress (..)
     , ApiT (..)
+    , ApiTransaction
     , ApiWallet (..)
+    , PostTransactionData
     , WalletBalance (..)
     , WalletPostData (..)
     , WalletPutData (..)
@@ -58,7 +60,7 @@ import Servant.Server
 -- | A Servant server for our wallet API
 server :: WalletLayer SeqState -> Server Api
 server w =
-    addresses w :<|> wallets w
+    addresses w :<|> wallets w :<|> transactions w
 
 {-------------------------------------------------------------------------------
                                     Wallets
@@ -163,6 +165,22 @@ listAddresses
 listAddresses _ _ _ =
     throwM err501
 
+{-------------------------------------------------------------------------------
+                                    Transactions
+-------------------------------------------------------------------------------}
+
+transactions :: WalletLayer SeqState -> Server Transactions
+transactions = createTransaction
+
+createTransaction
+    :: WalletLayer SeqState
+    -> ApiT WalletId
+    -> PostTransactionData
+    -> Handler ApiTransaction
+createTransaction _ _ _ =
+    throwM err501
+
+
 {-------------------------------------------------------------------------------
                                     Handlers
 -------------------------------------------------------------------------------}

src/Cardano/Wallet/Api/Types.hs

@@ -34,6 +34,10 @@ module Cardano.Wallet.Api.Types
     , WalletPostData (..)
     , WalletPutData (..)
     , WalletPutPassphraseData (..)
+    , PostTransactionData (..)
+    , ApiBlockData (..)
+    , ApiTransaction (..)
+    , ApiCoins (..)
 
     -- * Polymorphic Types
     , ApiT (..)
@@ -50,8 +54,12 @@ import Cardano.Wallet.Primitive.AddressDiscovery
 import Cardano.Wallet.Primitive.Types
     ( Address (..)
     , AddressState (..)
+    , Direction (..)
+    , Hash (..)
     , PoolId (..)
     , ShowFmt (..)
+    , SlotId (..)
+    , TxStatus (..)
     , WalletBalance (..)
     , WalletDelegation (..)
     , WalletId (..)
@@ -77,16 +85,24 @@ import Data.Aeson
     )
 import Data.Bifunctor
     ( bimap )
+import Data.List.NonEmpty
+    ( NonEmpty (..) )
+import Data.Quantity
+    ( Quantity (..) )
 import Data.Text
     ( Text )
 import Data.Text.Class
     ( FromText (..), ToText (..) )
+import Data.Time
+    ( UTCTime )
 import Fmt
     ( pretty )
 import GHC.Generics
     ( Generic )
 import GHC.TypeLits
     ( Nat, Symbol )
+import Numeric.Natural
+    ( Natural )
 import Web.HttpApiData
     ( FromHttpApiData (..), ToHttpApiData (..) )
 
@@ -129,6 +145,33 @@ data WalletPutPassphraseData = WalletPutPassphraseData
     , newPassphrase :: !(ApiT (Passphrase "encryption"))
     } deriving (Eq, Generic, Show)
 
+data PostTransactionData = PostTransactionData
+    { targets :: !(NonEmpty ApiCoins)
+    , passphrase :: !(ApiT (Passphrase "encryption"))
+    } deriving (Eq, Generic, Show)
+
+data ApiTransaction = Transaction
+    { id :: !(ApiT (Hash "Tx"))
+    , amount :: !(Quantity "lovelace" Natural)
+    , insertedAt :: !ApiBlockData
+    , depth :: !(Quantity "block" Natural)
+    , direction :: !(ApiT Direction)
+    , inputs :: !(NonEmpty ApiCoins)
+    , outputs :: !(NonEmpty ApiCoins)
+    , status :: !(ApiT TxStatus)
+    } deriving (Eq, Generic, Show)
+
+data ApiCoins = ApiCoins
+    { address :: !(ApiT Address)
+    , amount :: !(Quantity "lovelace" Natural)
+    } deriving (Eq, Generic, Show)
+
+data ApiBlockData = ApiBlockData
+    { time :: UTCTime
+    , block :: !(ApiT SlotId)
+    } deriving (Eq, Generic, Show)
+
+
 {-------------------------------------------------------------------------------
                               Polymorphic Types
 -------------------------------------------------------------------------------}
@@ -293,6 +336,47 @@ walletStateOptions = taggedSumTypeOptions $ TaggedObjectOptions
     , _contentsFieldName = "progress"
     }
 
+instance FromJSON PostTransactionData where
+    parseJSON = genericParseJSON defaultRecordTypeOptions
+instance ToJSON PostTransactionData where
+    toJSON = genericToJSON defaultRecordTypeOptions
+
+instance FromJSON (ApiT SlotId) where
+    parseJSON = fmap ApiT . genericParseJSON defaultRecordTypeOptions
+instance ToJSON (ApiT SlotId) where
+    toJSON = genericToJSON defaultRecordTypeOptions . getApiT
+
+instance FromJSON ApiBlockData where
+    parseJSON = genericParseJSON defaultRecordTypeOptions
+instance ToJSON ApiBlockData where
+    toJSON = genericToJSON defaultRecordTypeOptions
+
+instance FromJSON ApiCoins where
+    parseJSON = genericParseJSON defaultRecordTypeOptions
+instance ToJSON ApiCoins where
+    toJSON = genericToJSON defaultRecordTypeOptions
+
+instance FromJSON ApiTransaction where
+    parseJSON = genericParseJSON defaultRecordTypeOptions
+instance ToJSON ApiTransaction where
+    toJSON = genericToJSON defaultRecordTypeOptions
+
+instance FromJSON (ApiT (Hash "Tx")) where
+    parseJSON = parseJSON >=> eitherToParser . bimap ShowFmt ApiT . fromText
+instance ToJSON (ApiT (Hash "Tx")) where
+    toJSON = toJSON . toText . getApiT
+
+
+instance FromJSON (ApiT Direction) where
+    parseJSON = fmap ApiT . genericParseJSON defaultSumTypeOptions
+instance ToJSON (ApiT Direction) where
+    toJSON = genericToJSON defaultSumTypeOptions . getApiT
+
+instance FromJSON (ApiT TxStatus) where
+    parseJSON = fmap ApiT . genericParseJSON defaultSumTypeOptions
+instance ToJSON (ApiT TxStatus) where
+    toJSON = genericToJSON defaultSumTypeOptions . getApiT
+
 {-------------------------------------------------------------------------------
                              HTTPApiData instances
 -------------------------------------------------------------------------------}

src/Cardano/Wallet/Network/HttpBridge.hs

@@ -88,12 +88,12 @@ rbNextBlocks
     -> ExceptT ErrNetworkUnreachable m [Block]
 rbNextBlocks network start = do
     (tipHash, tip) <- fmap slotId <$> getNetworkTip network
-    epochBlocks <- nextStableEpoch (epochIndex start)
+    epochBlocks <- nextStableEpoch (epochNumber start)
     additionalBlocks <-
         if null epochBlocks then
             unstableBlocks tipHash tip
         else if length epochBlocks < 1000 then
-            nextStableEpoch (epochIndex start + 1)
+            nextStableEpoch (epochNumber start + 1)
         else
             pure []
     pure (epochBlocks ++ additionalBlocks)

src/Cardano/Wallet/Primitive/Types.hs

@@ -530,7 +530,7 @@ restrictedTo (UTxO utxo) outs =
 
 -- | A slot identifier is the combination of an epoch and slot.
 data SlotId = SlotId
-  { epochIndex :: !Word64
+  { epochNumber :: !Word64
   , slotNumber :: !Word16
   } deriving stock (Show, Eq, Ord, Generic)
 
@@ -560,7 +560,20 @@ instance Buildable (Hash "Tx") where
         <> "..."
         <> suffixF 8 builder
       where
-        builder = build . T.decodeUtf8 . convertToBase Base16 . getHash $ h
+        builder = build . toText $ h
+
+instance FromText (Hash "Tx") where
+    fromText x = either
+        (const $ Left $ TextDecodingError err)
+        (pure . Hash)
+        (convertFromBase Base16 $ T.encodeUtf8 x)
+      where
+        err = "Unable to decode (Hash \"Tx\"): \
+                    \expected Base16 encoding"
+
+
+instance ToText (Hash "Tx") where
+    toText = T.decodeUtf8 . convertToBase Base16 . getHash
 
 -- | A polymorphic wrapper type with a custom show instance to display data
 -- through 'Buildable' instances.