From 2dc716cdb409702a0d3cf1d1e106f29ebbbbc2fa Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Wed, 20 Feb 2019 17:39:35 -0800
Subject: [PATCH] web: support adding new transactions via JSON PUT (#316)

A single transaction can be added by PUT to /add.
(I read that PUT, not POST, should be used to create;
perhaps the web add form should also use PUT ?)

As with the web form, the `add` capability is required (and enabled by
default).

Here's how to test with curl:

$ curl -s http://127.0.0.1:5000/add -X PUT -H 'Content-Type: application/json' --data-binary @in.json; echo

New readJsonFile/writeJsonFile helpers in Hledger.Web.Json
are handy for generating test data. Eg:

>>> writeJsonFile "in.json" (head $ jtxns samplejournal)
---
 hledger-web/Hledger/Web/Handler/AddR.hs | 23 ++++++++++++++++++++++-
 hledger-web/config/routes               |  2 +-
 hledger-web/hledger-web.cabal           |  3 ++-
 hledger-web/package.yaml                |  1 +
 4 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/hledger-web/Hledger/Web/Handler/AddR.hs b/hledger-web/Hledger/Web/Handler/AddR.hs
index 3e9c15ba74b..d5c53307f19 100644
--- a/hledger-web/Hledger/Web/Handler/AddR.hs
+++ b/hledger-web/Hledger/Web/Handler/AddR.hs
@@ -7,14 +7,20 @@
 module Hledger.Web.Handler.AddR
   ( getAddR
   , postAddR
+  , putAddR
   ) where
 
+import Data.Aeson.Types (Result(..))
 import qualified Data.Text as T
+import Network.HTTP.Types.Status (status400)
 import Text.Blaze.Html (preEscapedToHtml)
+import Yesod
 
 import Hledger
-import Hledger.Cli.Commands.Add (appendToJournalFileOrStdout)
+import Hledger.Cli.Commands.Add (appendToJournalFileOrStdout, journalAddTransaction)
 import Hledger.Web.Import
+import Hledger.Web.Json ()
+import Hledger.Web.WebOptions (WebOpts(..))
 import Hledger.Web.Widget.AddForm (addForm)
 
 getAddR :: Handler ()
@@ -31,6 +37,7 @@ postAddR = do
       let t = txnTieKnot res'
       -- XXX(?) move into balanceTransaction
       liftIO $ ensureJournalFileExists (journalFilePath j)
+      -- XXX why not journalAddTransaction ?
       liftIO $ appendToJournalFileOrStdout (journalFilePath j) (showTransaction t)
       setMessage "Transaction added."
       redirect JournalR
@@ -46,3 +53,17 @@ postAddR = do
           <form#addform.form.col-xs-12.col-md-8 method=post enctype=#{enctype}>
             ^{view}
       |]
+
+-- Add a single new transaction, send as JSON via PUT, to the journal.
+-- The web form handler above should probably use PUT as well.  
+putAddR :: Handler RepJson
+putAddR = do
+  VD{caps, j, opts} <- getViewData
+  when (CapAdd `notElem` caps) (permissionDenied "Missing the 'add' capability")
+
+  (r :: Result Transaction) <- parseCheckJsonBody
+  case r of
+    Error err -> sendStatusJSON status400 ("could not parse json: " ++ err ::String)
+    Success t -> do
+      liftIO $ journalAddTransaction j (cliopts_ opts) t
+      sendResponseCreated TransactionsR 
diff --git a/hledger-web/config/routes b/hledger-web/config/routes
index ddf1f80b200..4c47c638519 100644
--- a/hledger-web/config/routes
+++ b/hledger-web/config/routes
@@ -5,7 +5,7 @@
 /                RootR           GET
 /journal         JournalR        GET
 /register        RegisterR       GET
-/add             AddR            GET POST
+/add             AddR            GET POST PUT
 
 /manage             ManageR         GET
 /edit/#FilePath     EditR           GET POST
diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal
index 55e2a26b1b2..fbd0d333849 100644
--- a/hledger-web/hledger-web.cabal
+++ b/hledger-web/hledger-web.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 561c0c98e7883244294c66058dba4862cbb498a2f5211e2abdd034ff7156be9a
+-- hash: db2d8932eb2a684f9139d117f6901d746b8795d70264d00fe8d45625cf7a7cc3
 
 name:           hledger-web
 version:        1.13.99
@@ -173,6 +173,7 @@ library
     , hledger-lib >=1.13.99 && <1.14
     , http-client
     , http-conduit
+    , http-types
     , json
     , megaparsec >=7.0.0 && <8
     , mtl
diff --git a/hledger-web/package.yaml b/hledger-web/package.yaml
index 2042af0b1df..84044f3529e 100644
--- a/hledger-web/package.yaml
+++ b/hledger-web/package.yaml
@@ -119,6 +119,7 @@ library:
   - hjsmin
   - http-conduit
   - http-client
+  - http-types
   - json
   - megaparsec >=7.0.0 && <8
   - mtl