diff options
Diffstat (limited to 'Omni')
| -rw-r--r-- | Omni/Bild/Deps/Haskell.nix | 1 | ||||
| -rw-r--r-- | Omni/Bild/Haskell.nix | 1 | ||||
| -rw-r--r-- | Omni/Task.hs | 1 | ||||
| -rw-r--r-- | Omni/Task/Core.hs | 67 |
4 files changed, 44 insertions, 26 deletions
diff --git a/Omni/Bild/Deps/Haskell.nix b/Omni/Bild/Deps/Haskell.nix index d714799..7e3650a 100644 --- a/Omni/Bild/Deps/Haskell.nix +++ b/Omni/Bild/Deps/Haskell.nix @@ -50,6 +50,7 @@ "servant-lucid" "servant-server" "split" + "sqids" "sqlite-simple" "stm" "tasty" diff --git a/Omni/Bild/Haskell.nix b/Omni/Bild/Haskell.nix index 7e969da..e55dee9 100644 --- a/Omni/Bild/Haskell.nix +++ b/Omni/Bild/Haskell.nix @@ -26,6 +26,7 @@ in rec { servant-auth = doJailbreak sup.servant-auth; servant-auth-server = dontCheck sup.servant-auth-server; shellcheck = doJailbreak sup.shellcheck; + sqids = dontCheck sup.sqids; string-qq = doJailbreak sup.string-qq; syb-with-class = doJailbreak sup.syb-with-class; th-abstraction = doJailbreak sup.th-abstraction; diff --git a/Omni/Task.hs b/Omni/Task.hs index a724e82..7ad0548 100644 --- a/Omni/Task.hs +++ b/Omni/Task.hs @@ -5,6 +5,7 @@ -- : out task -- : dep sqlite-simple +-- : dep sqids -- : modified by benign worker module Omni.Task where diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs index af982d8..5b1551c 100644 --- a/Omni/Task/Core.hs +++ b/Omni/Task/Core.hs @@ -12,8 +12,7 @@ import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.List as List import qualified Data.Text as T import qualified Data.Text.IO as TIO -import Data.Time (UTCTime, diffTimeToPicoseconds, getCurrentTime, utctDay, utctDayTime) -import Data.Time.Calendar (toModifiedJulianDay) +import Data.Time (UTCTime, getCurrentTime) import qualified Database.SQLite.Simple as SQL import qualified Database.SQLite.Simple.FromField as SQL import qualified Database.SQLite.Simple.Ok as SQLOk @@ -22,6 +21,7 @@ import GHC.Generics () import System.Directory (createDirectoryIfMissing, doesFileExist) import System.Environment (lookupEnv) import System.IO.Unsafe (unsafePerformIO) +import qualified Web.Sqids as Sqids -- Core data types data Task = Task @@ -242,18 +242,48 @@ initTaskDb = do \ created_at TIMESTAMP NOT NULL, \ \ updated_at TIMESTAMP NOT NULL \ \)" + SQL.execute_ + conn + "CREATE TABLE IF NOT EXISTS id_counter (\ + \ id INTEGER PRIMARY KEY CHECK (id = 1), \ + \ counter INTEGER NOT NULL DEFAULT 0 \ + \)" + SQL.execute_ + conn + "INSERT OR IGNORE INTO id_counter (id, counter) VALUES (1, 0)" + +-- Sqids configuration: lowercase alphabet only, minimum length 8 +sqidsOptions :: Sqids.SqidsOptions +sqidsOptions = + Sqids.defaultSqidsOptions + { Sqids.alphabet = "abcdefghijklmnopqrstuvwxyz0123456789", + Sqids.minLength = 8, + Sqids.blocklist = [] + } --- Generate a short ID using base36 encoding of timestamp (lowercase) +-- Generate a short ID using sqids with sequential counter generateId :: IO Text generateId = do - now <- getCurrentTime - let day = utctDay now - dayTime = utctDayTime now - mjd = toModifiedJulianDay day - micros = diffTimeToPicoseconds dayTime `div` 1000000 - totalMicros = (mjd * 100000000000) + micros - encoded = toBase36 totalMicros - pure <| "t-" <> T.pack encoded + counter <- getNextCounter + let encoded = case Sqids.runSqids sqidsOptions (Sqids.encode [counter]) of + Left _ -> "00000000" + Right sqid -> sqid + pure <| "t-" <> encoded + +-- Get the next counter value (atomically increments) +getNextCounter :: IO Int +getNextCounter = + withDb <| \conn -> do + SQL.execute_ + conn + "CREATE TABLE IF NOT EXISTS id_counter (\ + \ id INTEGER PRIMARY KEY CHECK (id = 1), \ + \ counter INTEGER NOT NULL DEFAULT 0 \ + \)" + SQL.execute_ conn "INSERT OR IGNORE INTO id_counter (id, counter) VALUES (1, 0)" + SQL.execute_ conn "UPDATE id_counter SET counter = counter + 1 WHERE id = 1" + [SQL.Only c] <- SQL.query_ conn "SELECT counter FROM id_counter WHERE id = 1" :: IO [SQL.Only Int] + pure c -- Generate a child ID based on parent ID generateChildId :: Text -> IO Text @@ -279,21 +309,6 @@ getSuffix parent childId = else Nothing else Nothing --- Convert number to base36 (0-9, a-z) -toBase36 :: Integer -> String -toBase36 0 = "0" -toBase36 n = reverse <| go n - where - alphabet = ['0' .. '9'] ++ ['a' .. 'z'] - go 0 = [] - go x = - let (q, r) = x `divMod` 36 - idx = fromIntegral r - char = case drop idx alphabet of - (c : _) -> c - [] -> '0' - in char : go q - -- Load all tasks from DB loadTasks :: IO [Task] loadTasks = |