git.mcksp
    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
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}

module Stripe
    ( checkout
    , details
    ) where

import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Data.ByteString.Lazy.Char8 as BSLU
import GHC.Generics
import Data.Aeson

authHeader = ("Authorization", "Bearer $auth")

details :: Manager -> IO String
details manager = do
    initialRequest <- parseRequest "https://api.stripe.com/v1/account"
    let request = initialRequest
            { method = "GET"
            , requestHeaders = [ authHeader ]
            }

    response <- httpLbs request manager
    return $ BSLU.unpack $ responseBody response

checkout :: Manager -> IO String
checkout manager = do
    initialRequest <- parseRequest "https://api.stripe.com/v1/checkout/sessions"
    let session = CreateSession { success_url = "https://mckb.co"
        , cancel_url = "https://mckb.co/error"
        , payment_method_types = ["card"]
        , mode = "payment"
        }
    let pairs = [("success_url", "https://mckb.co"),
                 ("cancel_url", "https://mckb.co/error"),
                 ("payment_method_types[0]", "card"),
                 ("mode", "payment"),
                 ("line_items[0][price]", "price_1JTo5jLT9ieWaueRUfOy0faT"),
                 ("line_items[0][quantity]", "2"),
                 ("line_items[1][price]", "price_1JToBtLT9ieWaueRGeNtoF9z"),
                 ("line_items[1][quantity]", "2")]

    let request = initialRequest
            { method = "POST"
            , requestHeaders = [ authHeader ]
            }

    response <- httpLbs (urlEncodedBody pairs request) manager
    let session = decode (responseBody response) :: Maybe Session
    let redir = case session of
            Nothing -> "error"
            Just value -> url value
    return redir

data CreateSession = CreateSession
    { success_url :: String
    , cancel_url :: String
    , payment_method_types :: [String]
    , mode :: String
    }
    deriving (Show, Generic)

instance FromJSON CreateSession
instance ToJSON CreateSession

data Item = Item
    { price :: String
    , quantity :: Int
    }
    deriving (Show, Generic)

instance FromJSON Item
instance ToJSON Item

data Session = Session
    { url :: String
    }
    deriving (Show, Generic)

instance FromJSON Session
instance ToJSON Session