1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
| {-# LANGUAGE DeriveGeneric #-}
module Stripe
( CheckoutSession(..)
, createCheckout
, StripeEvent(..)
, StripeData(..)
, StripeObject(..)
, validateWebhook
) where
import GHC.Generics (Generic)
import Network.HTTP.Simple
import Data.Aeson
import Data.Text (Text)
import qualified Data.Text as T
import Data.ByteString (ByteString)
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Digest.Pure.SHA
import qualified Data.ByteString.Lazy as BL
import Env
data CheckoutSession = CheckoutSession
{ id :: Text
, mode :: Text
, url :: Text
, client_reference_id :: Text
} deriving (Show, Generic)
instance ToJSON CheckoutSession where
instance FromJSON CheckoutSession where
data StripeEvent = StripeEvent
{ id :: Text
, created :: Int
, eventType :: Text
, eventData :: StripeData
} deriving (Show, Generic)
instance ToJSON StripeEvent where
instance FromJSON StripeEvent where
parseJSON = withObject "StripeEvent" $ \obj -> do
eventId <- obj .: "id"
created <- obj .: "created"
eventType <- obj .: "type"
eventData <- obj .: "data"
return $ StripeEvent {
id = eventId,
created = created,
eventType = eventType,
eventData = eventData
}
data StripeData = StripeData
{ object :: StripeObject
} deriving (Show, Generic)
instance ToJSON StripeData where
instance FromJSON StripeData where
data StripeObject = StripeObject
{ id :: Text
, object :: Text
, customer :: Text
, client_reference_id :: Maybe Text
} deriving (Show, Generic)
instance ToJSON StripeObject where
instance FromJSON StripeObject where
createCheckout :: Text -> IO CheckoutSession
createCheckout uId = do
let request = setRequestMethod "POST"
$ setRequestSecure True
$ setRequestPort 443
$ setRequestHost "api.stripe.com"
$ setRequestPath "/v1/checkout/sessions"
$ setRequestBearerAuth stripeEnv.apikey
$ setRequestBodyURLEncoded (checkoutRequest uId)
$ defaultRequest
response <- httpJSON request
let body = getResponseBody response :: CheckoutSession
return body
validateWebhook :: Maybe Text -> Text -> Bool
validateWebhook header body = do
let valsArray = map (T.splitOn "=") . T.splitOn "," <$> header
let vals = map (\[k,v] -> (k, v)) <$> valsArray
let t = vals >>= lookup "t"
let v = vals >>= lookup "v1"
checkSignature t v body
checkSignature :: Maybe Text -> Maybe Text -> Text -> Bool
checkSignature (Just t) (Just v) body = do
let payload = t <> "." <> body
let hm = showDigest $ hmacSha256 (BL.fromChunks . return $ stripeEnv.webhookSecret) $ BL.fromChunks . return $ encodeUtf8 $ payload
T.pack hm == v
checkSignature _ _ _ = False
checkoutRequest :: Text -> [(ByteString, ByteString)]
checkoutRequest uId =
[ ("success_url", "https://getshortstories.com/success")
, ("cancel_url", "https://getshortstories.com/failure")
, ("mode", "subscription")
, ("client_reference_id", encodeUtf8 uId)
, ("line_items[0][price]", "price_1POjNNLT9ieWaueRdXnGhpnu")
, ("line_items[0][quantity]", "1")
]
|