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