WIP: Rk is backdrop modal widget impure validation haveibeenpwned

.obelisk/impl/github.json

@@ -1,7 +1,7 @@
 {
   "owner": "obsidiansystems",
   "repo": "obelisk",
-  "branch": "develop",
-  "rev": "86a9584c6d7648bd5324ef57d62421fed1bf1978",
-  "sha256": "1lbii87j5530ncm6brfbzkd3wg16mgxazsf3l56zzv4c8cydilmh"
+  "branch": "cg-fullroute",
+  "rev": "0d98be9c5b49bda50fdc172a6b62477d80fc20ac",
+  "sha256": "16zd733m3cbq8228412bqyhivyblwpj24xfdygd7k25ml5f0f41k"
 }

backend-db/Network/PushNotification/Worker.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
+
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Network.PushNotification.Worker where
 
@@ -23,7 +24,6 @@ import Rhyolite.Backend.DB
 import Rhyolite.Backend.Schema
 import Rhyolite.Backend.Schema.TH
 import Rhyolite.Concurrent
-import Rhyolite.Request.TH
 import Rhyolite.Schema
 import GHC.Generics
 
@@ -49,11 +49,12 @@ makeDefaultKeyIdInt64 ''ApplePushMessage 'ApplePushMessageKey
 
 data AndroidPushMessage = AndroidPushMessage
   { _androidPushMessage_payload :: Json FcmPayload }
+  deriving (Generic)
 
+instance ToJSON AndroidPushMessage
+instance FromJSON AndroidPushMessage
 instance HasId AndroidPushMessage
 
-makeJson ''AndroidPushMessage
-
 mkRhyolitePersist (Just "migrateAndroidPushMessage") [groundhog|
   - entity: AndroidPushMessage
 |]

backend-db/Rhyolite/Backend/Schema.hs

@@ -28,7 +28,6 @@ import Database.PostgreSQL.Simple.ToField (ToField, toField, Action)
 import Database.PostgreSQL.Simple.Types (Binary (..), Identifier (..))
 
 import Rhyolite.Schema (Json (..), SchemaName(..), LargeObjectId(..), HasId (..), Id (..))
-import Rhyolite.Backend.Schema.TH (makePersistFieldNewtype)
 import Rhyolite.Backend.Schema.Class (DerivedEntity, DerivedEntityHead, DefaultKeyId, toIdData, fromIdData)
 
 instance ToField SchemaName where
@@ -125,4 +124,11 @@ toShowUniverse = toField . T.pack . show
 
 instance Exception VisibleUniverseFailure
 
-makePersistFieldNewtype ''SchemaName
+instance PersistField SchemaName where
+  persistName _ = "SchemaName"
+  toPersistValues (SchemaName x) = toPersistValues x
+  fromPersistValues pv = do
+    (x, pv') <- fromPersistValues pv
+    return (SchemaName x, pv')
+  dbType p (SchemaName x) = dbType p x
+

backend-db/Rhyolite/Backend/Schema/TH.hs

@@ -13,7 +13,14 @@
 
 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-redundant-constraints #-}
 
-module Rhyolite.Backend.Schema.TH where
+module Rhyolite.Backend.Schema.TH
+  ( deriveNewtypePersistBackend
+  , makeDefaultKeyIdInt64
+  , makeDefaultKeyIdSimple
+  , mkRhyolitePersist
+  , makePersistFieldNewtype
+  , module Rhyolite.Backend.Schema
+  ) where
 
 import Control.Lens ((%~), _head)
 import Control.Monad
@@ -29,6 +36,7 @@ import Database.Groundhog.TH.Settings (PersistDefinitions(..))
 import Language.Haskell.TH
 
 import Rhyolite.TH (conName)
+import Rhyolite.Backend.Schema -- Not needed for this module, but without it, the generated code fails to compile in a way which is confusing, so we re-export it.
 import Rhyolite.Backend.Schema.Class
 
 deriveNewtypePersistBackend :: (TypeQ -> TypeQ) -> (TypeQ -> TypeQ) -> Name -> Name -> DecsQ