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
|
{-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell,
TypeFamilies, GADTs, GeneralizedNewtypeDeriving,
MultiParamTypeClasses, DerivingStrategies, StandaloneDeriving,
UndecidableInstances, DataKinds, FlexibleInstances, TypeOperators #-}
{-# OPTIONS -Wno-missing-export-lists #-}
module Data.PendingBang where
import Data.Aeson
import Database.Persist.TH
import Data.Char (isAlphaNum)
import Data.Maybe (maybeToList)
import qualified Data.Text as T
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
PendingBang
bang T.Text
url T.Text
displayName T.Text
notifyEmail (Maybe T.Text)
UniqueBang bang url displayName
deriving Show
|]
instance ToJSON PendingBang where
toJSON (PendingBang b u dp em) = object $
["bang" .= b, "url" .= u, "name" .= dp] ++ case em of
Nothing -> []
Just e -> ["email" .= e]
toEncoding (PendingBang b u dp em) = pairs $ case em of
Nothing -> withoutEmail
Just e -> withoutEmail <> "email" .= e
where withoutEmail = "bang" .= b <> "url" .= u <> "name" .= dp
instance FromJSON PendingBang where
parseJSON = withObject "PendingBang" $ \ob ->
PendingBang
<$> ob .: "bang"
<*> ob .: "url"
<*> ob .: "name"
<*> ob .:? "email"
verifyPendingBang :: PendingBang -> Bool
verifyPendingBang (PendingBang n u dp mayEm) =
T.all isAlphaNum n &&
all ((<255) . T.length) strings &&
emailOk mayEm
where strings = [n, u, dp] <> maybeToList mayEm
emailOk Nothing = True
emailOk (Just e) =
T.all (\c -> isAlphaNum c || c `T.elem` "@-.") e &&
T.take 1 e /= "-"
|
