From fc5b4ab1f047e950f8a497d3a29b7adec76608a8 Mon Sep 17 00:00:00 2001 From: Jake <j.vondoemming@stud.uni-goettingen.de> Date: Tue, 29 Nov 2022 23:16:15 +0100 Subject: [PATCH 1/4] did some redis stuff --- .gitignore | 1 + aoc-proxy.cabal | 2 ++ src/Config.hs | 14 ++++++++++++++ src/DB.hs | 21 +++++++++++++++++++++ src/Main.hs | 4 +++- src/Routes.hs | 3 +++ 6 files changed, 44 insertions(+), 1 deletion(-) create mode 100644 src/DB.hs diff --git a/.gitignore b/.gitignore index ae41ee4..cd46bc6 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ /dist* *.swp +*.rdb diff --git a/aoc-proxy.cabal b/aoc-proxy.cabal index de39a97..7d35513 100644 --- a/aoc-proxy.cabal +++ b/aoc-proxy.cabal @@ -28,6 +28,7 @@ executable aoc-proxy other-modules: Config, Common, Routes, + DB, Templates other-extensions: OverloadedStrings, ScopedTypeVariables build-depends: happstack-lite -any, @@ -45,6 +46,7 @@ executable aoc-proxy base -any, text -any, data-default -any, + hedis -any, ginger >=0.10.4.0 hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Config.hs b/src/Config.hs index 1cde085..88fdfc3 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -3,6 +3,8 @@ module Config where import Happstack.Lite +import Database.Redis +--import Database.Redis.Connection aocServerConfig :: ServerConfig aocServerConfig = ServerConfig { port = 8000 @@ -18,3 +20,15 @@ templatesDir = "templates" configFile :: FilePath configFile = "config.json" + +dbConnectInfo = defaultConnectInfo + { connectHost = "localhost" + , connectPort = PortNumber 6379 -- Redis default port + , connectAuth = Nothing -- No password + , connectDatabase = 0 -- SELECT database 0 + --, connectMaxConnections = 50 -- Up to 50 connections + --, connectMaxIdleTime = 30 -- Keep open for 30 seconds + --, connectTimeout = Nothing -- Don't add timeout logic + --, connectTLSParams = Nothing -- Do not use TLS + } + diff --git a/src/DB.hs b/src/DB.hs new file mode 100644 index 0000000..bc4abd8 --- /dev/null +++ b/src/DB.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} + +module DB where + +import Config + +import Database.Redis +import Control.Monad.IO.Class + + +dbTest :: IO () +dbTest = do + conn <- checkedConnect defaultConnectInfo + runRedis conn $ do + set "hello" "hello" + set "world" "world" + hello <- get "hello" + world <- get "world" + liftIO $ print (hello,world) + disconnect conn + diff --git a/src/Main.hs b/src/Main.hs index a851327..026730b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -6,6 +6,7 @@ import Common import Config import Routes import Templates +import DB import Control.Applicative ((<$>), optional) import Data.Maybe (fromMaybe) @@ -57,7 +58,8 @@ main = do printParseErrors errs exitFailure Right templates' -> do - + + dbTest -- Serve Files putStrLn ("Hosting aoc-proxy on http://localhost:" ++ (show (port aocServerConfig)) ++ " ...") serve (Just aocServerConfig) (routes templates' configGVal) diff --git a/src/Routes.hs b/src/Routes.hs index c884b70..526da80 100644 --- a/src/Routes.hs +++ b/src/Routes.hs @@ -45,5 +45,8 @@ handlerFileServing :: ServerPart Response handlerFileServing = serveDirectory EnableBrowsing ["index.html"] "static" +handlerTest :: ServerPart Response +handlerTest = + serveDirectory EnableBrowsing ["index.html"] "static" -- GitLab From 829f47b20109e283e68a33c4a3925445cfb21a4c Mon Sep 17 00:00:00 2001 From: Jake <j.vondoemming@stud.uni-goettingen.de> Date: Wed, 30 Nov 2022 00:45:36 +0100 Subject: [PATCH 2/4] ignore .env --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index cd46bc6..026ad80 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ /dist* *.swp *.rdb +.env -- GitLab From 995a0c1c4cc8660f16bb24c5bfb01633679f59ba Mon Sep 17 00:00:00 2001 From: Jake <j.vondoemming@stud.uni-goettingen.de> Date: Wed, 30 Nov 2022 00:45:53 +0100 Subject: [PATCH 3/4] updated README.md --- README.md | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 7360b5a..0e2c0ed 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ Allgemein: ```bash sudo apt update -sudo apt install cabal-install zlib1g-dev +sudo apt install cabal-install zlib1g-dev redis export PATH=~/.cabal/bin:$PATH ``` @@ -15,6 +15,11 @@ cabal update cabal install ``` +## Ausführen + +1. Redis starten +2. `make run` + ## Links - https://hackage.haskell.org/package/happstack-lite-7.3.8/docs/Happstack-Lite.html - https://www.happstack.com/page/view-page-slug/9/happstack-lite -- GitLab From 4d41e32ac12b48e13002ac3001a0e3cab4b3d1b1 Mon Sep 17 00:00:00 2001 From: Jake <j.vondoemming@stud.uni-goettingen.de> Date: Wed, 30 Nov 2022 04:45:58 +0100 Subject: [PATCH 4/4] added Database interaction --- aoc-proxy.cabal | 3 + src/DB.hs | 182 +++++++++++++++++++++++++++++++++++++++++++++--- src/Main.hs | 6 +- 3 files changed, 181 insertions(+), 10 deletions(-) diff --git a/aoc-proxy.cabal b/aoc-proxy.cabal index 7d35513..a9f8920 100644 --- a/aoc-proxy.cabal +++ b/aoc-proxy.cabal @@ -45,6 +45,9 @@ executable aoc-proxy binary >=0.8.6.0, base -any, text -any, + hxt -any, + time -any, + advent-of-code-api >=0.2.8.1, data-default -any, hedis -any, ginger >=0.10.4.0 diff --git a/src/DB.hs b/src/DB.hs index bc4abd8..271e12d 100644 --- a/src/DB.hs +++ b/src/DB.hs @@ -4,18 +4,182 @@ module DB where import Config +--import qualified Data.ByteString (concat, ByteString(..)) +import Data.ByteString as BS +import Data.ByteString.Lazy.UTF8 as BLU +import Data.ByteString.UTF8 as BSU +import Data.ByteString.Char8 as BSC + import Database.Redis import Control.Monad.IO.Class +import Text.XML.HXT.DOM.Util (decimalStringToInt) + +import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) + +import Advent + + +------------------------ +-- KEYS +------------------------ + +prefix :: BS.ByteString +prefix = "aoc:" + +keySolution :: Day -> BS.ByteString +keySolution d = (BS.concat [prefix, "solution:", BSU.fromString (show (dayInt d))]) + + +keyData :: Day -> BS.ByteString +keyData d = (BS.concat [prefix, "data:", BSU.fromString (show (dayInt d))]) + +keyUsers :: BS.ByteString +keyUsers = (BS.concat [prefix, "users"]) + +keyUserName :: Int -> BS.ByteString +keyUserName uid = (BS.concat [prefix, "user:", BSU.fromString (show uid), ":name"]) + +keyUserSolved :: Int -> BS.ByteString +keyUserSolved uid = (BS.concat [prefix, "user:", BSU.fromString (show uid), ":solved"]) -dbTest :: IO () -dbTest = do - conn <- checkedConnect defaultConnectInfo - runRedis conn $ do - set "hello" "hello" - set "world" "world" - hello <- get "hello" - world <- get "world" - liftIO $ print (hello,world) + +------------------------ +-- GENERIC FUNCTIONS +------------------------ + + +-- https://mmhaskell.com/real-world/redis +runRedisAction :: Redis a -> IO a +runRedisAction action = do + conn <- connect dbConnectInfo + res <- runRedis conn action disconnect conn + return res + +------------------------ +-- SPECIFIC FUNCTIONS +------------------------ + +dbInit :: IO () +dbInit = runRedisAction $ do + set (BS.concat [prefix, "test"]) "yeet" + liftIO $ Prelude.putStrLn ("DB: Initialized Database.") + +--dbTest :: IO () +--dbTest = do +-- conn <- checkedConnect dbConnectInfo +-- runRedis conn $ do +-- set (BS.concat [prefix, "hello"]) "hello" +-- set (BS.concat [prefix, "world"]) "world" +-- hello <- get (BS.concat [prefix, "hello"]) +-- world <- get (BS.concat [prefix, "world"]) +-- liftIO $ Prelude.putStrLn (hello,world) +-- disconnect conn + +-- only set name if user doesn't exist yet +dbCreateUser :: Int -> String -> IO () +dbCreateUser uid name = runRedisAction $ do + sadd keyUsers [BSU.fromString (show uid)] + res <- setnx (keyUserName uid) (BSU.fromString name) + case res of + Right True -> liftIO $ Prelude.putStrLn ("DB: Created User '" ++ name ++ "' ("++ show uid ++ ")") + _ -> return () + +dbGetUserName :: Int -> IO String +dbGetUserName uid = runRedisAction $ do + res <- get (BSU.fromString (show uid)) + case res of + Right (Just name) -> return (BSU.toString name) + _ -> return "Unknown" -- Username is not determined. + +dbSetUserName :: Int -> String -> IO (Either Reply Status) +dbSetUserName uid name = runRedisAction $ do + set (keyUserName uid) (BSU.fromString name) + +dbGetUsers :: IO [Int] +dbGetUsers = runRedisAction $ do + res <- smembers keyUsers + case res of + Right rawIDs -> return (Prelude.map decimalStringToInt (Prelude.map BSU.toString rawIDs)) + _ -> do + liftIO $ Prelude.putStrLn ("DB: Failed to get users.") + return [] + +-- get what tasks and when a user has solved +------------------------------ day, solve time +dbGetUserSolved :: Int -> IO [(Day, POSIXTime)] +dbGetUserSolved uid = do + solved <- dbGetUserSolved' uid + return (Prelude.map convert solved) + where + --convert (a, b) = (BSU.toString a, BSU.toString b) + convert (a, b) = ( (mkDay_ (toInteger (decimalStringToInt (BSU.toString a))) :: Day) + , (fromInteger (toInteger (decimalStringToInt (BSU.toString a))) :: POSIXTime) ) + dbGetUserSolved' :: Int -> IO [(BSU.ByteString, BSU.ByteString)] + dbGetUserSolved' uid' = runRedisAction $ do + res <- hgetall (keyUserSolved uid') + case res of + Right solved -> return solved + _ -> return [] + + +-- user solved the task of day right now +dbUserSolved :: Int -> Day -> IO Bool +dbUserSolved uid day = do + curtime <- getPOSIXTime + runRedisAction $ do + res <- hsetnx (keyUserSolved uid) (BSU.fromString (show (dayInt day))) (BSU.fromString (show curtime)) + case res of + Right succ -> return succ + _ -> return False + + + +dbCacheSolution :: Day -> BSU.ByteString -> IO Bool +dbCacheSolution day sol = runRedisAction $ do + res <- setnx (keySolution day) sol + case res of + Right succ -> do + liftIO $ Prelude.putStrLn ("DB: Cached Solution for day " ++ (show (dayInt day)) ++ ": '" ++ (BSU.toString sol) ++ "' (" ++ (show succ) ++ ")" ) + return succ + _ -> return False + + + +dbGetCachedSolution :: Day -> IO (Maybe BSU.ByteString) +dbGetCachedSolution day = runRedisAction $ do + res <- get (keySolution day) + case res of + Right maySol -> return maySol + _ -> return Nothing + + + + + +dbCacheData :: Day -> BSU.ByteString -> IO Bool +dbCacheData day d = runRedisAction $ do + res <- setnx (keyData day) d + case res of + Right succ -> do + liftIO $ Prelude.putStrLn ("DB: Cached Data for day " ++ (show (dayInt day)) ++ ": '" ++ (BSU.toString d) ++ "' (" ++ (show succ) ++ ")" ) + return succ + _ -> return False + + + +dbGetCachedData :: Day -> IO (Maybe BSU.ByteString) +dbGetCachedData day = runRedisAction $ do + res <- get (keyData day) + case res of + Right mayData -> return mayData + _ -> return Nothing + + + + + + + diff --git a/src/Main.hs b/src/Main.hs index 026730b..c75ae52 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -59,7 +59,11 @@ main = do exitFailure Right templates' -> do - dbTest + -- Init Database + dbInit + --users <- dbGetUsers + --putStrLn ("User IDs: " ++ (show users)) + -- Serve Files putStrLn ("Hosting aoc-proxy on http://localhost:" ++ (show (port aocServerConfig)) ++ " ...") serve (Just aocServerConfig) (routes templates' configGVal) -- GitLab