On Mon, 10 Jul 2017 18:44:44 -0700 Bryan Richter <br...@snowdrift.coop> wrote:
> To whom it may concern:
>
> fr33domlover and I know this doesn't compile.. it was submitted for
> discussion.
>
> Now, on with the discussing:
>
> On Tue, Jul 11, 2017 at 03:57:31AM +0300, fr33domlover wrote:
> > From: fr33domlover <fr33domlo...@riseup.net>
> >
> > ---
> > crowdmatch/crowdmatch.cabal | 3 ++-
> > crowdmatch/src/Crowdmatch.hs | 32 +++++++++++++++++++++++---------
> > website/src/AppDataTypes.hs | 6 ++----
> > website/src/Handler/PaymentInfo.hs | 11 ++---------
> > website/src/Handler/Util.hs | 14 ++++++++++----
> > 5 files changed, 39 insertions(+), 27 deletions(-)
> >
> > diff --git a/crowdmatch/crowdmatch.cabal b/crowdmatch/crowdmatch.cabal
> > index d378766..2c602f1 100644
> > --- a/crowdmatch/crowdmatch.cabal
> > +++ b/crowdmatch/crowdmatch.cabal
> > @@ -28,7 +28,8 @@ library
> > hs-source-dirs: src
> > default-language: Haskell2010
> > build-depends:
> > - base >=4.8 && <4.9
> > + aeson
> > + , base >=4.8 && <4.9
> > , bytestring >= 0.10.6.0
> > , errors
> > , lens
> > diff --git a/crowdmatch/src/Crowdmatch.hs b/crowdmatch/src/Crowdmatch.hs
> > index fe61387..ad0489c 100644
> > --- a/crowdmatch/src/Crowdmatch.hs
> > +++ b/crowdmatch/src/Crowdmatch.hs
> > @@ -14,7 +14,9 @@ module Crowdmatch (
> > , SqlRunner
> >
> > -- * Interface with stripe
> > + , StripeClient
> > , StripeRunner
> > + , runStripeWith
> > , runStripe
> >
> > -- * Store/delete payment tokens
> > @@ -58,10 +60,12 @@ import Control.Error (ExceptT(..), runExceptT, note)
> > import Control.Lens ((^.), from, view, Iso', iso)
> > import Control.Monad (void)
> > import Control.Monad.IO.Class (MonadIO, liftIO)
> > +import Data.Aeson (FromJSON)
> > import Data.Function (on)
> > import Data.Int (Int32)
> > import Data.Ratio
> > import Data.Time (UTCTime, getCurrentTime, utctDay)
> > +import Data.Typeable (Typeable)
> > import Database.Persist
> > import Database.Persist.Sql (SqlPersistT)
> > import System.IO
> > @@ -73,6 +77,7 @@ import Web.Stripe.Customer
> > , createCustomer
> > , deleteCustomer)
> > import Web.Stripe.Error (StripeError)
> > +import Web.Stripe.StripeRequest (StripeRequest, StripeReturn)
> >
> > import Crowdmatch.Model hiding (Patron(..))
> > import qualified Crowdmatch.Model as Model
> > @@ -87,6 +92,10 @@ import qualified Crowdmatch.Skeleton as Skeleton
> > -- | A method that runs 'SqlPersistT' values in your environment.
> > type SqlRunner io env = forall a. SqlPersistT io a -> env a
> >
> > +type StripeClient = forall a.
> > + (Typeable (StripeReturn a), FromJSON (StripeReturn a)) =>
> > + StripeConfig -> StripeRequest a -> IO (Either StripeError
> > (StripeReturn a))
> > +
>
> I had lots of pain trying to use (or avoid using) the type signatures
> around my mock stripe functions. I have a suspicion that this one, in
> particular, is not something we want or need.
This type is simply the type of the 'stripe' function from stripe-haskell
package! With an added Typeable constraint because you used it in appStripe,
idk why but I just followed it.
Obviously we can use that long ugly type instead of the short alias. It's
internal anyway, so doesn't matter.
>
> > -- | A method that runs 'StripeI' instructions in IO. A default that uses
> > -- 'stripe' is provided by 'runStripe'.
> > type StripeRunner = forall io.
> > @@ -441,20 +450,19 @@ data StripeI a where
> > ChargeCustomerI :: CustomerId -> Cents -> StripeI Charge
> > BalanceTransactionI :: TransactionId -> StripeI BalanceTransaction
> >
> > --- | A default stripe runner
> > -runStripe
> > +runStripeWith
> > :: MonadIO io
> > - => StripeConfig -> StripeI a -> io (Either StripeError a)
> > -runStripe c = \case
> > + => StripeClient -> StripeConfig -> StripeI a -> io (Either StripeError
> > a) +runStripeWith strp c = \case
>
> We definitely don't want this. At best, we may want a better name than
> 'runStripe'. It is intended to be a default StripeI runner that
> actually uses the real 'stripe'.
>
> StripeI is already the abstraction -- abstracting over its runner
> shouldn't be necessary. (See more comments below, at the definition of
> 'snowstripe'.)
There is a reason I added 'runStripeWith': It allows to create a runner not
based on 'stripe'. Now, you may ask, but isn't that what 'dummyStripe' is for?
The answer is yes, but you chose to have 'appStripe' in 'App', and respecting
that decision, I had to have a variant of 'runStripe' that wouldn't hard-code
'stripe' in it, and instead would take it as a parameter. That way, you can
pass to it whatever 'appStripe' is in the web app.
An alternative is to change the type of 'appStripe' to have the same type
signature as the 'runStripe' function, and then you can pass 'runStripe' or
'dummyStripe' to it. I'm leaving the decision to you. I don't mind, I'm happy
to change the type, especially if it fixes the scary error :P
>
> > CreateCustomerI cardToken ->
> > - liftIO (stripe c (createCustomer -&- cardToken))
> > + liftIO (strp c (createCustomer -&- cardToken))
> > UpdateCustomerI cardToken cust ->
> > - liftIO (stripe c (updateCustomer cust -&- cardToken))
> > + liftIO (strp c (updateCustomer cust -&- cardToken))
> > DeleteCustomerI cust ->
> > - void <$> liftIO (stripe c (deleteCustomer cust))
> > + void <$> liftIO (strp c (deleteCustomer cust))
> > ChargeCustomerI cust cents ->
> > liftIO
> > - . stripe c
> > + . strp c
> > . (-&- cust)
> > -- Supported upstream as of 2016-10-06, but not in our
> > resolver yet -- . (-&- ExpandParams ["balance_transaction"])
> > @@ -462,7 +470,13 @@ runStripe c = \case
> > . view chargeCents
> > $ cents
> > BalanceTransactionI transId ->
> > - liftIO (stripe c (getBalanceTransaction transId))
> > + liftIO (strp c (getBalanceTransaction transId))
> > +
> > +-- | A default stripe runner
> > +runStripe
> > + :: MonadIO io
> > + => StripeConfig -> StripeI a -> io (Either StripeError a)
> > +runStripe = runStripeWith stripe
> >
> > --
> > -- Making payments
> > diff --git a/website/src/AppDataTypes.hs b/website/src/AppDataTypes.hs
> > index 39ea400..62428a2 100644
> > --- a/website/src/AppDataTypes.hs
> > +++ b/website/src/AppDataTypes.hs
> > @@ -16,6 +16,7 @@ import Yesod.Core.Types (Logger)
> > import Yesod.GitRev
> >
> > import AuthSite
> > +import Crowdmatch
> > import Settings
> >
> > -- | The God-object available to every Handler. This is the site's
> > @@ -30,10 +31,7 @@ data App = App
> > , appAuth :: AuthSite
> > -- | The function for doing stripe API calls. Swapped out for a mock
> > -- thing in tests.
> > - , appStripe :: forall a. (Typeable (StripeReturn a), FromJSON
> > (StripeReturn a))
> > - => StripeConfig
> > - -> StripeRequest a
> > - -> IO (Either StripeError (StripeReturn a))
> > + , appStripe :: StripeClient
>
> I will agree this looks a little nicer, but I'm not sure it's worth fighting
> GHC over.
Yeah like I wrote above, I don't care about the type alias.
>
> > }
> >
> > -- This function generates the route types, and also generates the
> > diff --git a/website/src/Handler/PaymentInfo.hs
> > b/website/src/Handler/PaymentInfo.hs index 80c66b9..f17babd 100644
> > --- a/website/src/Handler/PaymentInfo.hs
> > +++ b/website/src/Handler/PaymentInfo.hs
> > @@ -54,20 +54,14 @@ deletePaymentInfoForm :: Form ()
> > deletePaymentInfoForm =
> > identifyForm delFormId (renderDivsNoLabels deleteFromPost)
> >
> > -stripeConf :: Handler StripeConfig
> > -stripeConf = fmap
> > - (StripeConfig . appStripeSecretKey . appSettings)
> > - getYesod
> > -
> > postPaymentInfoR :: Handler Html
> > postPaymentInfoR = handleDelete delFormId deletePaymentInfoR $ do
> > Entity uid User{..} <- requireAuth
> > - conf <- stripeConf
> > ((formResult, _), _) <-
> > runFormPost (identifyForm modFormId (paymentForm ""))
> > case formResult of
> > FormSuccess token -> do
> > - stripeRes <- runDB $ storePaymentToken (runStripe conf) uid
> > token
> > + stripeRes <- runDB $ storePaymentToken snowstripe uid token
> > case stripeRes of
> > Left e -> stripeError e
> > Right _ -> do
> > @@ -79,9 +73,8 @@ postPaymentInfoR = handleDelete delFormId
> > deletePaymentInfoR $ do
> > deletePaymentInfoR :: Handler Html
> > deletePaymentInfoR = do
> > - conf <- stripeConf
> > Entity uid User {..} <- requireAuth
> > - stripeDeletionHandler =<< runDB (deletePaymentToken (runStripe conf)
> > uid)
> > + stripeDeletionHandler =<< runDB (deletePaymentToken snowstripe uid)
> > redirect DashboardR
> > where
> > stripeDeletionHandler =
> > diff --git a/website/src/Handler/Util.hs b/website/src/Handler/Util.hs
> > index ca100f9..39d0db0 100644
> > --- a/website/src/Handler/Util.hs
> > +++ b/website/src/Handler/Util.hs
> > @@ -1,3 +1,5 @@
> > +{-# LANGUAGE RankNTypes #-}
> > +
> > module Handler.Util
> > ( snowdriftTitle
> > , snowdriftDashTitle
> > @@ -23,12 +25,16 @@ snowdriftTitle t = setTitle $
> > snowdriftDashTitle :: MonadWidget m => Text -> Text -> m ()
> > snowdriftDashTitle x y = snowdriftTitle $ x `mappend` " — " `mappend` y
> >
> > +stripeConf :: Handler StripeConfig
> > +stripeConf = fmap
> > + (StripeConfig . appStripeSecretKey . appSettings)
> > + getYesod
> > +
> > snowstripe :: StripeI a -> Handler (Either StripeError a)
> > snowstripe req = do
> > - conf <- fmap
> > - (StripeConfig . appStripeSecretKey . appSettings)
> > - getYesod
> > - liftIO (runStripe conf req)
> > + conf <- stripeConf
> > + client <- getsYesod appStripe
> > + liftIO $ runStripeWith client conf req
>
> Ahhh. Now I remember why the crowdmatch API methods weren't restricted
> to SqlPersistT. It was so that 'snowstripe' could be used directly
> where '(runStripe conf)' is used in Handlers right now! However, I
> think there's an easy fix... I think you can 'lift' a Handler action
> to a DB action.
I already made 'snowstripe' used directly in handlers, not sure that original
consideration matters now :P
> Also, regarding my earlier statement. Snowdrift-the-website just needs
> some sort of runner for StripeI actions. It chooses to use 'runStripe'
> because it wants to use the real stripe.
Then, perhaps, like I suggested, we can put 'runStripe' itself in the
'appStripe' field, rather than the lower level 'stripe'.
> Snowdrift's tests use a different runner, dummyStripe. Because it
> operates on StripeI directly, it only has to handle the instructions
> we actually use (i.e. the data constructors of StripeI). If the tests
> used your new runStripeWith, it would either have to be partial, or
> handle every upstream Stripe command!
Sure, 'runStripeWith' is just a helper as I explained, that's the only reason
it exists.
> I'm just sort of rambling right now. If you aren't following what I'm
> saying, don't worry.. I'll show the code when I get the chance.
If you want to put 'runStripe' in 'appStripe', I'm happy to make a new patch
for that. If you want to keep things as-is, then yeah I don't really know how
to fix the type error.
> >
> > -- | The form element that can be inserted to handle a delete.
> > deleteFromPost
> > --
> > 1.9.1
pgpQBZUgFL5MQ.pgp
Description: OpenPGP digital signature
_______________________________________________ Dev mailing list Dev@lists.snowdrift.coop https://lists.snowdrift.coop/mailman/listinfo/dev
