about summary refs log tree commit diff
path: root/users/wpcarro/website/sandbox/learnpianochords/src/server/Types.hs
blob: 4a72865153abec8fdfc7c328a86b2204f9a1ae81 (plain) (blame)
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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
--------------------------------------------------------------------------------G
module Types where
--------------------------------------------------------------------------------
import RIO
import Data.Aeson
import Network.HTTP.Req
import Web.Internal.HttpApiData (ToHttpApiData(..))
import System.Envy (FromEnv, fromEnv, env)
--------------------------------------------------------------------------------

-- | Read from .envrc
data Env = Env
  { envGoogleClientID :: !Text
  , envServerPort :: !Int
  , envClientPort :: !Int
  , envStripeAPIKey :: !Text
  } deriving (Eq, Show)

instance FromEnv Env where
  fromEnv _ = do
    envGoogleClientID <- env "GOOGLE_CLIENT_ID"
    envStripeAPIKey <- env "STRIPE_API_KEY"
    envServerPort <- env "SERVER_PORT"
    envClientPort <- env "CLIENT_PORT"
    pure Env {..}

-- | Application context: a combination of Env and additional values.
data Context = Context
  { contextGoogleClientID :: !Text
  , contextStripeAPIKey :: !Text
  , contextServerPort :: !Int
  , contextClientPort :: !Int
  }

-- | Top-level except for our application, as RIO recommends defining.
type Failure = ()

-- | When our app executes along the "happy path" this is the type of result it
-- produces.
type Success = ()

-- | This is our application monad.
type AppM = RIO Context

-- | The concrete type of our application.
type App = AppM (Either Failure Success)

data VerifyGoogleSignInRequest = VerifyGoogleSignInRequest
  { idToken :: !Text
  } deriving (Eq, Show)

instance FromJSON VerifyGoogleSignInRequest where
  parseJSON = withObject "VerifyGoogleSignInRequest" $ \x -> do
    idToken <- x .: "idToken"
    pure VerifyGoogleSignInRequest{..}

data GoogleLinkedAccount = GoogleLinkedAccount
  {
  -- { googleLinkedAccountUUID :: UUID
  -- , googleLinkedAccountEmail :: Email
  -- , googleLinkedAccountTsCreated :: Timestamp
    googleLinkedAccountGivenName :: !(Maybe Text)
  , googleLinkedAccountFamilyName :: !(Maybe Text)
  , googleLinkedAccountFullName :: !(Maybe Text)
  -- , googleLinkedAccountPictureURL :: URL
  -- , googleLinkedAccountLocale :: Maybe Locale
  } deriving (Eq, Show)

data PayingCustomer = PayingCustomer
  {
  -- { payingCustomerAccountUUID :: UUID
  -- , payingCustomerTsCreated :: Timestamp
  } deriving (Eq, Show)

data Session = Session
  {
  -- { sessionUUID :: UUID
  -- , sessionAccountUUID :: UUID
  -- , sessionTsCreated :: Timestamp
  } deriving (Eq, Show)

data CurrencyCode = USD
  deriving (Eq, Show)

instance ToJSON CurrencyCode where
  toJSON USD = String "usd"

instance FromJSON CurrencyCode where
  parseJSON = withText "CurrencyCode" $ \x ->
    case x of
      "usd" -> pure USD
      _ -> fail "Expected a valid currency code like: \"usd\""

instance ToHttpApiData CurrencyCode where
  toQueryParam USD = "usd"

data PaymentIntent = PaymentIntent
  { paymentIntentAmount :: !Int
  , paymentIntentCurrency :: !CurrencyCode
  } deriving (Eq, Show)

instance ToJSON PaymentIntent where
  toJSON PaymentIntent{..} =
    object [ "amount" .= paymentIntentAmount
           , "currency" .= paymentIntentCurrency
           ]

instance FromJSON PaymentIntent where
  parseJSON = withObject "" $ \x -> do
    paymentIntentAmount <- x .: "amount"
    paymentIntentCurrency <- x .: "currency"
    pure PaymentIntent{..}

instance QueryParam PaymentIntent where
  queryParam = undefined

-- All applications have their secrets... Using the secret type ensures that no
-- sensitive information will get printed to the screen.
newtype Secret = Secret Text deriving (Eq)

instance Show Secret where
  show (Secret _) = "[REDACTED]"

instance ToJSON Secret where
  toJSON (Secret x) = toJSON x

instance FromJSON Secret where
  parseJSON = withText "Secret" $ \x -> pure $ Secret x

data CreatePaymentIntentResponse = CreatePaymentIntentResponse
  { clientSecret :: Secret
  } deriving (Eq, Show)

instance ToJSON CreatePaymentIntentResponse where
  toJSON CreatePaymentIntentResponse{..} =
    object [ "clientSecret" .= clientSecret
           ]

data StripePaymentIntent = StripePaymentIntent
  { pmtIntentClientSecret :: Secret
  } deriving (Eq, Show)

instance FromJSON StripePaymentIntent where
  parseJSON = withObject "StripeCreatePaymentIntentResponse" $ \x -> do
    pmtIntentClientSecret <- x .: "client_secret"
    pure StripePaymentIntent{..}