Refactor, use app tokens

16 files changed, 19 insertions, 136 deletions

diff --git a/fig-web/src/Fig/Web/DB.hs b/fig-web/src/Fig/Web/DB.hs
deleted file mode 100644
index fb5a98c..0000000
--- a/fig-web/src/Fig/Web/DB.hs
+++ /dev/null
@@ -1,114 +0,0 @@
-module Fig.Web.DB where
-
-import Control.Error.Util (hush)
-
-import Data.Maybe (mapMaybe)
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-
-import qualified Database.Redis as Redis
-
-import Fig.Prelude
-import Fig.Web.Types
-import Fig.Web.Utils
-
-connect :: MonadIO m => Config -> m DB
-connect cfg = liftIO $ DB <$> Redis.checkedConnect Redis.defaultConnectInfo
-  { Redis.connectHost = unpack cfg.dbHost
-  }
-
-run :: MonadIO m => DB -> Redis.Redis a -> m a
-run (DB c) f = liftIO $ Redis.runRedis c f
-
-get :: ByteString -> Redis.Redis (Maybe ByteString)
-get key = do
-  v <- Redis.get key
-  pure . join $ hush v
-
-del :: [ByteString] -> Redis.Redis ()
-del keys = do
-  void $ Redis.del keys
-
-incr :: ByteString -> Redis.Redis ()
-incr key = do
-  void $ Redis.incr key
-
-decr :: ByteString -> Redis.Redis ()
-decr key = do
-  void $ Redis.decr key
-
-hset :: ByteString -> ByteString -> ByteString -> Redis.Redis ()
-hset key hkey val = do
-  void $ Redis.hset key hkey val
-
-hget :: ByteString -> ByteString -> Redis.Redis (Maybe ByteString)
-hget key hkey = do
-  v <- Redis.hget key hkey
-  pure . join $ hush v
-
-hdel :: ByteString -> ByteString -> Redis.Redis ()
-hdel key hkey = do
-  void $ Redis.hdel key [hkey]
-
-hmset :: ByteString -> [(ByteString, ByteString)] -> Redis.Redis ()
-hmset key m = do
-  void $ Redis.hmset key m
-
-hmget :: ByteString -> [ByteString] -> Redis.Redis (Map ByteString ByteString)
-hmget key hk = do
-  Redis.hmget key hk >>= \case
-    Left _ -> pure Map.empty
-    Right vals -> do
-      pure . Map.fromList . mapMaybe (\(a, mb) -> mb >>= \b -> Just (a, b)) $ zip hk vals 
-
-hgetall :: ByteString -> Redis.Redis (Map ByteString ByteString)
-hgetall key = do
-  Redis.hgetall key >>= \case
-    Left _ -> pure Map.empty
-    Right m -> pure $ Map.fromList m
-
-hkeys :: ByteString -> Redis.Redis (Maybe [ByteString])
-hkeys key = do
-  hush <$> Redis.hkeys key
-
-hvals :: ByteString -> Redis.Redis (Maybe [ByteString])
-hvals key = do
-  hush <$> Redis.hvals key
-
-sadd :: ByteString -> [ByteString] -> Redis.Redis ()
-sadd key skeys = do
-  void $ Redis.sadd key skeys
-
-srem :: ByteString -> [ByteString] -> Redis.Redis ()
-srem key skeys = do
-  void $ Redis.srem key skeys
-
-smembers :: ByteString -> Redis.Redis (Maybe [ByteString])
-smembers key = do
-  hush <$> Redis.smembers key
-
-sismember :: ByteString -> ByteString -> Redis.Redis Bool
-sismember key skey = do
-  Redis.sismember key skey >>= hush >>> \case
-    Just x -> pure x
-    Nothing -> pure False
-
-lpop :: ByteString -> Redis.Redis (Maybe ByteString)
-lpop key = do
-  join . hush <$> Redis.lpop key
-
-rpush :: ByteString -> ByteString -> Redis.Redis ()
-rpush key val = do
-  void $ Redis.rpush key [val]
-
-lrange :: ByteString -> Integer -> Integer -> Redis.Redis [ByteString]
-lrange key start end = do
-  fromMaybe [] . hush <$> Redis.lrange key start end
-
-llen :: ByteString -> Redis.Redis (Maybe Integer)
-llen key = do
-  hush <$> Redis.llen key
-
-lindex :: ByteString -> Integer -> Redis.Redis (Maybe ByteString)
-lindex key idx = do
-  join . hush <$> Redis.lindex key idx
diff --git a/fig-web/src/Fig/Web/Module/Advent.hs b/fig-web/src/Fig/Web/Module/Advent.hs
index d1bfe1c..dff11e3 100644
--- a/fig-web/src/Fig/Web/Module/Advent.hs
+++ b/fig-web/src/Fig/Web/Module/Advent.hs
@@ -8,7 +8,7 @@ import Text.HTML.SanitizeXSS (sanitize)
 import Fig.Web.Utils
 import Fig.Web.Types
 import Fig.Web.Auth
-import Fig.Web.DB as DB
+import Fig.Utils.DB as DB
 import qualified Fig.Utils.FFI as FFI
 
 keybase :: Integer -> Text -> Text -> ByteString
diff --git a/fig-web/src/Fig/Web/Module/Bells.hs b/fig-web/src/Fig/Web/Module/Bells.hs
index f4f8112..ba2d9cf 100644
--- a/fig-web/src/Fig/Web/Module/Bells.hs
+++ b/fig-web/src/Fig/Web/Module/Bells.hs
@@ -7,7 +7,7 @@ import Fig.Prelude
 import Fig.Utils.SExpr
 import Fig.Web.Utils
 import Fig.Web.Types
-import qualified Fig.Web.DB as DB
+import qualified Fig.Utils.DB as DB
 
 public :: PublicModule
 public a = do
diff --git a/fig-web/src/Fig/Web/Module/Debt.hs b/fig-web/src/Fig/Web/Module/Debt.hs
index 643f99f..60f1ab7 100644
--- a/fig-web/src/Fig/Web/Module/Debt.hs
+++ b/fig-web/src/Fig/Web/Module/Debt.hs
@@ -9,7 +9,7 @@ import qualified Data.Map.Strict as Map
 
 import Fig.Web.Utils
 import Fig.Web.Types
-import qualified Fig.Web.DB as DB
+import qualified Fig.Utils.DB as DB
 
 public :: PublicModule
 public a = do
diff --git a/fig-web/src/Fig/Web/Module/Exchange.hs b/fig-web/src/Fig/Web/Module/Exchange.hs
index 11af071..aacf207 100644
--- a/fig-web/src/Fig/Web/Module/Exchange.hs
+++ b/fig-web/src/Fig/Web/Module/Exchange.hs
@@ -5,8 +5,6 @@ module Fig.Web.Module.Exchange
 
 import Fig.Prelude
 
-import Control.Error.Util (hush)
-
 import qualified Database.Redis as Redis
 
 import Data.Maybe (mapMaybe)
@@ -20,6 +18,8 @@ import Fig.Web.Utils
 import Fig.Web.Types
 import Fig.Web.Auth
 
+import qualified Fig.Utils.DB as DB
+
 public :: PublicModule
 public a = do
   onGet "/api/exchange" do
diff --git a/fig-web/src/Fig/Web/Module/Gizmo.hs b/fig-web/src/Fig/Web/Module/Gizmo.hs
index 70078fb..b7f0248 100644
--- a/fig-web/src/Fig/Web/Module/Gizmo.hs
+++ b/fig-web/src/Fig/Web/Module/Gizmo.hs
@@ -14,7 +14,7 @@ import qualified Network.WebSockets as WS
 
 import Fig.Web.Utils
 import Fig.Web.Types
-import qualified Fig.Web.DB as DB
+import qualified Fig.Utils.DB as DB
 
 public :: PublicModule
 public a = do
diff --git a/fig-web/src/Fig/Web/Module/HLS.hs b/fig-web/src/Fig/Web/Module/HLS.hs
index 66242e5..fb3a717 100644
--- a/fig-web/src/Fig/Web/Module/HLS.hs
+++ b/fig-web/src/Fig/Web/Module/HLS.hs
@@ -8,7 +8,7 @@ import Data.Functor ((<&>))
 
 import Fig.Web.Utils
 import Fig.Web.Types
-import qualified Fig.Web.DB as DB
+import qualified Fig.Utils.DB as DB
 
 public :: PublicModule
 public a = do
diff --git a/fig-web/src/Fig/Web/Module/Misc.hs b/fig-web/src/Fig/Web/Module/Misc.hs
index c7ca250..3163b3f 100644
--- a/fig-web/src/Fig/Web/Module/Misc.hs
+++ b/fig-web/src/Fig/Web/Module/Misc.hs
@@ -10,7 +10,7 @@ import Control.Lens ((^?), Ixed (..))
 
 import Fig.Web.Utils
 import Fig.Web.Types
-import qualified Fig.Web.DB as DB
+import qualified Fig.Utils.DB as DB
 
 public :: PublicModule
 public a = do
diff --git a/fig-web/src/Fig/Web/Module/Puzzle.hs b/fig-web/src/Fig/Web/Module/Puzzle.hs
index b8e469b..5278721 100644
--- a/fig-web/src/Fig/Web/Module/Puzzle.hs
+++ b/fig-web/src/Fig/Web/Module/Puzzle.hs
@@ -17,7 +17,7 @@ import Fig.Utils.FFI (checkAnswer)
 import Fig.Web.Utils
 import Fig.Web.Types
 import Fig.Web.Auth
-import Fig.Web.DB
+import Fig.Utils.DB
 
 data Puzzle = Puzzle
   { pid :: Text
diff --git a/fig-web/src/Fig/Web/Module/Sentiment.hs b/fig-web/src/Fig/Web/Module/Sentiment.hs
index 41f90f3..2bf1edb 100644
--- a/fig-web/src/Fig/Web/Module/Sentiment.hs
+++ b/fig-web/src/Fig/Web/Module/Sentiment.hs
@@ -6,7 +6,7 @@ import Fig.Prelude
 
 import Fig.Web.Utils
 import Fig.Web.Types
-import qualified Fig.Web.DB as DB
+import qualified Fig.Utils.DB as DB
 
 public :: PublicModule
 public a = do
diff --git a/fig-web/src/Fig/Web/Module/Shader.hs b/fig-web/src/Fig/Web/Module/Shader.hs
index e5dfc95..a0773a7 100644
--- a/fig-web/src/Fig/Web/Module/Shader.hs
+++ b/fig-web/src/Fig/Web/Module/Shader.hs
@@ -6,7 +6,7 @@ import Fig.Prelude
 
 import Fig.Web.Utils
 import Fig.Web.Types
-import qualified Fig.Web.DB as DB
+import qualified Fig.Utils.DB as DB
 
 public :: PublicModule
 public a = do
diff --git a/fig-web/src/Fig/Web/Module/TCG.hs b/fig-web/src/Fig/Web/Module/TCG.hs
index e57cb28..4f7c094 100644
--- a/fig-web/src/Fig/Web/Module/TCG.hs
+++ b/fig-web/src/Fig/Web/Module/TCG.hs
@@ -11,7 +11,7 @@ import qualified Data.ByteString as BS
 
 import Fig.Web.Utils
 import Fig.Web.Types
-import qualified Fig.Web.DB as DB
+import qualified Fig.Utils.DB as DB
 
 public :: PublicModule
 public a = do
diff --git a/fig-web/src/Fig/Web/Module/User.hs b/fig-web/src/Fig/Web/Module/User.hs
index 1e82e0b..550130c 100644
--- a/fig-web/src/Fig/Web/Module/User.hs
+++ b/fig-web/src/Fig/Web/Module/User.hs
@@ -16,7 +16,8 @@ import qualified Database.Redis as Redis
 import Fig.Web.Utils
 import Fig.Web.Types
 import Fig.Web.Auth
-import qualified Fig.Web.DB as DB
+import Fig.Utils.DB (DB)
+import qualified Fig.Utils.DB as DB
 
 getText :: MonadIO m => DB -> ByteString -> m (Maybe Text)
 getText db key = do
diff --git a/fig-web/src/Fig/Web/Public.hs b/fig-web/src/Fig/Web/Public.hs
index 69678bb..816f724 100644
--- a/fig-web/src/Fig/Web/Public.hs
+++ b/fig-web/src/Fig/Web/Public.hs
@@ -10,10 +10,10 @@ import qualified Network.Wai.Handler.Warp as Warp
 
 import qualified Web.Scotty as Sc
 
+import qualified Fig.Utils.DB as DB
 import Fig.Bus.Binary.Client
 import Fig.Web.Types
 import Fig.Web.Utils
-import qualified Fig.Web.DB as DB
 import qualified Fig.Web.Module.Misc as Misc
 import qualified Fig.Web.Module.TwitchAuth as TwitchAuth
 import qualified Fig.Web.Module.Exchange as Exchange
@@ -39,7 +39,7 @@ server :: PublicOptions -> Config -> (Text, Text) -> IO ()
 server options cfg busAddr = do
   log $ "Web server running on port " <> tshow cfg.port
   log "Connecting to database..."
-  db <- DB.connect cfg
+  db <- DB.connect cfg.dbHost
   channels <- newChannels
   globals <- newGlobals
   busClient busAddr
diff --git a/fig-web/src/Fig/Web/Secure.hs b/fig-web/src/Fig/Web/Secure.hs
index 5aebff8..b1f04f5 100644
--- a/fig-web/src/Fig/Web/Secure.hs
+++ b/fig-web/src/Fig/Web/Secure.hs
@@ -10,11 +10,11 @@ import qualified Network.Wai.Handler.Warp as Warp
 
 import qualified Web.Scotty as Sc
 
+import qualified Fig.Utils.DB as DB
 import Fig.Bus.Binary.Client
 import Fig.Web.Types
 import Fig.Web.Utils
 import Fig.Web.Auth
-import qualified Fig.Web.DB as DB
 import qualified Fig.Web.Module.Exchange as Exchange
 import qualified Fig.Web.Module.Redeem as Redeem
 import qualified Fig.Web.Module.Advent as Advent
@@ -29,7 +29,7 @@ server :: SecureOptions -> Config -> (Text, Text) -> IO ()
 server options cfg busAddr = do
   log $ "Web server running on port " <> tshow cfg.port
   log "Connecting to database..."
-  db <- DB.connect cfg
+  db <- DB.connect cfg.dbHost
   channels <- newChannels
   globals <- newGlobals
   busClient busAddr
diff --git a/fig-web/src/Fig/Web/Types.hs b/fig-web/src/Fig/Web/Types.hs
index 3390d88..176f2ac 100644
--- a/fig-web/src/Fig/Web/Types.hs
+++ b/fig-web/src/Fig/Web/Types.hs
@@ -5,7 +5,6 @@ module Fig.Web.Types
   , newChannels
   , Globals(..)
   , newGlobals
-  , DB(..)
   , ModuleArgs(..)
   , PublicOptions(..), SecureOptions(..)
   , PublicModuleArgs, SecureModuleArgs
@@ -26,10 +25,9 @@ import qualified Network.WebSockets as WS
 
 import qualified Web.Scotty as Sc
 
-import qualified Database.Redis as Redis
-
 import qualified Data.Aeson as Aeson
 
+import Fig.Utils.DB
 import Fig.Bus.Binary.Client
 import Fig.Web.Utils
 
@@ -69,8 +67,6 @@ newGlobals = do
   currentlyLive <- MVar.newMVar Set.empty
   pure Globals {..}
 
-newtype DB = DB { conn :: Redis.Connection }
-
 data ModuleArgs o = ModuleArgs
   { cfg :: Config
   , cmds :: Commands IO