Add retrieval/storage of current exchange rate data to payment recording.

Dependencies

• [2] BSIUHCGF Add payment response handler.
• [3] AL37SVTC Implement payments service endpoints.
• [4] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
• [5] LAROLAYU WIP
• [6] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
• [7] Q5X5RYQL stylish-haskell reformatting
• [8] MJ6R42RC Utility methods for reading key & cert data.
• [9] WZUHEZSB Start of migration back toward snap.
• [10] OBFPJS2G Project successfully builds and tests under nix.
• [11] HMDM3B55 Implement core of payments/billing infrastructure.
• [12] GCVQD44V Create amends endpoint, switch to UUID primary keys
• [13] QADKFHAR Adds CreatePayment handler implementation.
• [14] Z7KS5XHH Very WIP. Wow.
• [15] JFOEOFGA stylish-haskell formatting.
• [16] EZQG2APB Update task list.
• [17] Y3LIJ5US Add handler for CreatePaymentRequest
• [18] QMRKFEPG Refactor QDB to use a free monad algebra instead.
• [19] AVDFWICB More musings for the TASKS file.
• [20] 373LXH2X Add MAYBE.md, update task list.
• [21] W35DDBFY Factor common JSON conversions up into client lib module.
• [22] 6L5BK5EH Use generic SMTP rather than Sendmail-specific mail client.
• [23] SEWTRB6S Implement payment request creation functions.
• [24] ZP62WC47 Begin conversion to build with stack.
• [25] ASF3UPJL Add auction creation and bid handlers
• [26] WAIX6AGN Add event serialization for PaymentRequest & Payment
• [27] NEDDHXUK Reformat via stylish-haskell
• [28] BROSTG5K Beginning of modularization of server.
• [29] DFOBMSAO Initial work on payments API
• [30] IZEVQF62 Work in progress replacing sqlite with postgres.
• [31] A6HKMINB Attempting to improve JSON handling.
• [32] 5XFJNUAZ Start of addition of project infrastructure.
• [33] 4IQVQL4T Added client for payouts endpoint.
• [34] 2Y2QZFVF Switch to more modern cabal2nix-based workflow.
• [35] 7KZP4RHZ Switch from Data.Time to Data.Thyme
• [36] V2VDN77H Enable postgres configuration via environment variable for Heroku.
• [37] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
• [38] M4KM76DG Merge branch 'stackify'
• [39] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
• [40] O227CEAV Adds storage of original event JSON for some DBOp constructors.
• [41] TCOAKCGG Completed conversion to snap.
• [42] 4U7F3CPI THE GREAT RENAMING OF THINGS!
• [43] 4FDQGIXN Make payment request retrieval key an opaque 32-bit hash.
• [44] PBD7LZYQ Postgres & auth are beginning to function.
• [45] POX3UAMT Enabling logging of time to contributor/project accounts
• [46] 5W5M56VJ Move library code to 'lib'
• [47] KEP5WUFJ Convert project to stack-based build.
• [48] HE3JTXO3 Added client call to payouts.
• [49] HALRDT2F Added initial auction create route.
• [*] EKI57EJR Add alternative implementation of auction winner determination.
• [*] ADMKQQGC Initial empty Snap project.

Change contents

• replacement in TASKS.md at line 63
  [3.338]→[3.338:350](∅→∅),[3.350]→[3.1817:1923](∅→∅)
  − * Payouts

  − * Use the BIP-70 Bitcoin Payment Protocol to create payment requests.

  − * Record requested payments
  [3.338]

  [3.2757]
  + * Migrate to servant-snap? https://github.com/haskell-servant/servant-snap
• replacement in TASKS.md at line 75
  [3.2263]→[3.2263:2343](∅→∅)
  − to correctly report capital gains, in much the same fasion as is done for
  [3.2263]

  [3.2343]
  + to correctly report capital gains, in much the same fashion as is done for
• edit in aftok.cabal at line 26
  [3.156]→[3.203:238](∅→∅),[3.203]→[3.203:238](∅→∅)
  − Aftok.Client
• edit in aftok.cabal at line 61
  [3.387]

  [51.1]
  + , lens-aeson
• edit in aftok.cabal at line 77
  [3.2906]→[3.544:563](∅→∅)
  − , wreq
• replacement in aftok.cabal at line 155
  [3.3169]→[3.635:664](∅→∅)
  − --, HsOpenSSL
  [3.3169]

  [3.41]
  + , HsOpenSSL

  + , http-client

  + , http-client-openssl
• edit in aftok.cabal at line 161
  [3.696]→[3.696:730](∅→∅)
  − --, MonadCatchIO-transformers
• edit in aftok.cabal at line 165
  [3.71]→[3.731:761](∅→∅),[3.7376]→[3.731:761](∅→∅)
  − --, resource-pool-catchio
• edit in aftok.cabal at line 174
  [3.1612]

  [3.1]
  + , wreq
• file deletion: Client.hs (----------)Client.hs (----------)
  [3.18]→[3.508:541](∅→∅),[3.541]→[3.1:1](∅→∅),[3.679]→[3.777:810](∅→∅),[3.810]→[3.1:1](∅→∅)
  − {-# LANGUAGE NoImplicitPrelude #-}

  − {-# LANGUAGE OverloadedStrings #-}

  − {-# LANGUAGE ScopedTypeVariables #-}

  −

  − module Aftok.Client where

  −

  − import ClassyPrelude

  −

  − import Control.Lens

  − import Data.Aeson.Types

  − import qualified Data.Configurator as C

  − import qualified Data.Configurator.Types as CT

  − import Network.Wreq

  −

  − import Aftok.Json

  − import Aftok.TimeLog

  −

  − data QCConfig = QCConfig

  − { aftokUrl :: String

  − } deriving Show

  −

  − parseQCConfig :: CT.Config -> IO QCConfig

  − parseQCConfig cfg =

  − QCConfig <$> C.require cfg "aftokUrl"

  −

  − currentPayouts :: QCConfig -> IO Payouts

  − currentPayouts cfg = do

  − resp <- get (aftokUrl cfg <> "payouts")

  − valueResponse <- asValue resp

  − either fail pure (parseEither parsePayoutsJSON $ valueResponse ^. responseBody)

  −

  −
• edit in lib/Aftok/Database/PostgreSQL.hs at line 191
  [3.2726]

  [3.293]
  + <*> field
• replacement in lib/Aftok/Database/PostgreSQL.hs at line 538
  [3.129]→[3.4113:4179](∅→∅)
  − \(payment_request_id, event_id, payment_data, payment_date) \
  [3.129]

  [3.4179]
  + \(payment_request_id, event_id, payment_data, payment_date, exchange_rates) \
• edit in lib/Aftok/Database/PostgreSQL.hs at line 544
  [3.4351]

  [3.339]
  + , p ^. exchangeRates
• replacement in lib/Aftok/Json.hs at line 222
  [3.3694]→[3.3694:4007](∅→∅)
  − [ "subscription_id" .= (r ^. (subscription . B._SubscriptionId . to tshow))

  − , "payment_request_protobuf_64" .= (r ^. (paymentRequest . to (decodeUtf8 . B64.encode . runPut . encodeMessage)))

  − , "payment_request_time" .= (r ^. paymentRequestTime)

  − , "billing_date" .= (r ^. (billingDate . to showGregorian))
  [3.3694]

  [3.4007]
  + [ "subscription_id" .=

  + view (subscription . B._SubscriptionId . to tshow) r

  + , "payment_request_protobuf_64" .=

  + view (paymentRequest . to (decodeUtf8 . B64.encode . runPut . encodeMessage)) r

  + , "url_key" .= view (paymentKey . _PaymentKey) r

  + , "payment_request_time" .= view paymentRequestTime r

  + , "billing_date" .= view (billingDate . to showGregorian) r
• edit in lib/Aftok/Payments/Types.hs at line 13
  [3.10704]

  [2.1974]
  + import Data.Aeson (Value)
• replacement in lib/Aftok/Payments/Types.hs at line 46
  [3.11301]→[3.11301:11383](∅→∅)
  − { _request :: r

  − , _payment :: P.Payment

  − , _paymentDate :: C.UTCTime
  [3.11301]

  [3.6913]
  + { _request :: r

  + , _payment :: P.Payment

  + , _paymentDate :: C.UTCTime

  + , _exchangeRates :: Maybe Value
• replacement in lib/Aftok/Payments.hs at line 113
  [3.13427]→[2.3097:3114](∅→∅)
  − -- TODO: maybe
  [3.13427]

  [2.3114]
  + -- TODO: maybe make pkey a function of subscription, billable, bday
• replacement in server/Aftok/QConfig.hs at line 42
  [3.289]→[3.5199:5232](∅→∅),[3.5232]→[3.315:356](∅→∅),[3.315]→[3.315:356](∅→∅),[3.356]→[3.5233:5274](∅→∅)
  − { network :: BT.Network

  − , signingKeyFile :: System.IO.FilePath

  − , certsFile :: System.IO.FilePath
  [3.289]

  [3.392]
  + { network :: BT.Network

  + , signingKeyFile :: System.IO.FilePath

  + , certsFile :: System.IO.FilePath

  + , exchangeRateServiceURI :: String
• edit in server/Aftok/QConfig.hs at line 78
  [3.670]

  [3.670]
  + <*> C.require cfg "exchangeRateServiceURI"
• edit in server/Aftok/Snaplet/Payments.hs at line 1
  [3.9762]

  [2.3378]
  + {-# LANGUAGE TypeApplications #-}

  +
• replacement in server/Aftok/Snaplet/Payments.hs at line 11
  [3.5783]→[2.3506:3559](∅→∅)
  − import Control.Lens (view, _1, _2)
  [3.5783]

  [2.3559]
  + import Control.Lens (view, _1, _2, _Right, _Left, preview, (&), (.~))
• edit in server/Aftok/Snaplet/Payments.hs at line 16
  [2.3750]

  [3.9831]
  + import Network.HTTP.Client.OpenSSL

  + import Network.HTTP.Client (defaultManagerSettings, managerResponseTimeout, HttpException)

  + import Network.Wreq (asValue, responseBody, defaults, manager, getWith)

  + import OpenSSL.Session (context)
• replacement in server/Aftok/Snaplet/Payments.hs at line 21
  [3.9832]→[2.3751:3807](∅→∅)
  − import Snap.Core (readRequestBody)
  [3.9832]

  [2.3807]
  + import Snap.Core (readRequestBody, logError)
• edit in server/Aftok/Snaplet/Payments.hs at line 28
  [3.9901]

  [3.6029]
  + import Aftok.QConfig as QC
• replacement in server/Aftok/Snaplet/Payments.hs at line 43
  [2.3971]→[2.3971:4053](∅→∅)
  − paymentResponseHandler :: S.Handler App App PaymentId

  − paymentResponseHandler = do
  [2.3971]

  [2.4053]
  + paymentResponseHandler :: QC.BillingConfig -> S.Handler App App PaymentId

  + paymentResponseHandler cfg = do
• replacement in server/Aftok/Snaplet/Payments.hs at line 52
  [2.4331]→[2.4331:4401](∅→∅)
  − snapEval . liftdb . CreatePayment $ Payment (view _1 preq) pmnt now
  [2.4331]

  [2.4401]
  +

  + let opts = defaults & manager .~ Left (opensslManagerSettings context)

  + & manager .~ Left (defaultManagerSettings { managerResponseTimeout = Just 10000 } )

  +

  + exchResp <- liftIO . try $ asValue =<< (withOpenSSL $ getWith opts (exchangeRateServiceURI cfg))

  + _ <- traverse (logError . encodeUtf8 . tshow @ HttpException) (preview _Left exchResp)

  + let newPayment = Payment (view _1 preq) pmnt now (preview (_Right . responseBody) exchResp)

  + snapEval . liftdb $ CreatePayment newPayment
• replacement in server/Main.hs at line 63
  [2.4797]→[2.4797:4874](∅→∅)
  − <|> (void $ method POST paymentResponseHandler)
  [2.4797]

  [3.8383]
  + <|> (void . method POST . paymentResponseHandler $ billingConfig cfg)