WZFQDWW4XK6M4A4PQ7WQJUTZUPRGQR7V7ZVZY5ZTL5AMGIFMHB2QC
BSIUHCGFDFDFGWYMHZB7OVU3Z3IHPEUXRISIOPGZI2RUXZFDS2EQC
AVDFWICBJ3QNP3Z3I6OQ6GB6T3SG7K64LF6B4CDGISTE3QBFYP3QC
EZQG2APB36DDMIAYDPPDGOIXOD7K2RZZSGC2NKGZIHB2HZBTW7EQC
373LXH2XPXZJYSC4NJGWC7ZX3MBAPNMRQFKOWNB7T2XUHUKSZY2AC
DFOBMSAODB3NKW37B272ZXA2ML5HMIH3N3C4GT2DPEQS7ZFK4SNAC
4U7F3CPIDTK6JSEDMNMHVKSR7HOQDLZQD2PPVMDLHO5SFSIMUXZAC
64C6AWH66FDKU6UE6Z6JPX2J2GBM2JOPTH2GL6LHKAIUBGNGDZ5AC
HMDM3B557TO5RYP2IGFFC2C2VN6HYZTDQ47CJY2O37BW55DSMFZAC
EKI57EJR65DA5FPILAHGHHAIU5ITVGHA6V3775OX7GV5XD67OWRQC
7KZP4RHZ3QSYTPPQ257A65Z5UPX44TF2LAI2U5EMULQCLDCEUK2AC
RPAJLHMTUJU4AYNBOHVGHGGB4NY2NLY3BVPYN5FMWB3ZIMAUQHCQC
TCOAKCGGHOIRJCTZYEZQ3K6KCGL2LGAYGYFRGSPCHBTJJY2V6AXAC
AL37SVTCKRSG4HG2PCYK5Z7QSIZZH5JHH4Q2VLMXFAXSAQRFFG4QC
IZEVQF627FA7VV25KJAWYWGGC35LZUUBBQRPN5ZAINTQLPEDRTEAC
2XQD6KKKD6QVHFHAEMVE3XXY7X2T7BLTLL7XIILZAXNJJH2YONUQC
MJ6R42RCK2ASXAJ6QXDPMAW56RBOJ4F4HI2LFIV3KXFIKWYMQK3QC
5W5M56VJFJEBXMGBVKGCKPHOEMVTKUOQMLPJP7VNDQLTYNJXXLHQC
4IQVQL4TS35GL2GYZJG254TKJLL5EHMRSFT77Z4VTRZIG2TMBM3QC
NEDDHXUK3GNFMOFO3KLU7NRIHCTYNWBT3D6HTKZAOXFDE6HMDZ6AC
HE3JTXO37O4MOMWPZ4BRBHP53KBPZDG3PCSUCVNOKIS7IY26OCIAC
2Y2QZFVFSKXEFEGYJB5A7GI735ONWPCF7DVTIY5T73AUEVTZTBBQC
O5FVTOM6YFBLEPF3S576K6IMT6ZZ5VQCSB3YVXNS4CKBITKCRZ7AC
Z7KS5XHHC6PAMTVBHXY7KUSS3BWAOU6FSYIITUCFOOJZU4OUJHBAC
A6HKMINBNGQLLX4QJMYWKQ4JAEHVJ4HIRVDKPPDI3FJUO2AAB7OQC
SEWTRB6S5PO5MQBLCPVBD7XT2BDYNZUE2RO6Z2XENZRIOCN6OZJAC
QADKFHAR3KWQCNYU25Z7PJUGMD5WL26IU3DOAHBTRN2A7NKPUPKAC
W35DDBFYF6Z4ZPCFEO5RPAONZLYCSNTXUSTS6FIUUVZHCI6Q7GHAC
JFOEOFGA4CQR2LW43IVQGDZSPVJAD4KDN2DZMZXGM2QDIUD7AVCAC
V2VDN77HCSRYYWXDJJ2XOVHV4P6PVWNJZLXZ7JUYPQEZQIH5BZ3QC
ADMKQQGCGVSHHIMVQ4XFRDCG544SBJCYALSKZV45CQQBZ4ACUH2AC
{-# 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)
[ "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))
[ "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
{ network :: BT.Network
, signingKeyFile :: System.IO.FilePath
, certsFile :: System.IO.FilePath
{ network :: BT.Network
, signingKeyFile :: System.IO.FilePath
, certsFile :: System.IO.FilePath
, exchangeRateServiceURI :: String
snapEval . liftdb . CreatePayment $ Payment (view _1 preq) pmnt now
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