gemini-textboard 0.2.0.1 → 0.2.0.2
raw patch · 2 files changed
+18/−18 lines, 2 filesdep ~basedep ~base64
Dependency ranges changed: base, base64
Files
- app/Main.hs +12/−11
- gemini-textboard.cabal +6/−7
app/Main.hs view
@@ -30,6 +30,7 @@ import Data.Time.Clock (UTCTime, getCurrentTime) import Data.Time.Format (formatTime, defaultTimeLocale, rfc822DateFormat) import qualified Crypto.Nonce as Nonce+import Data.Base64.Types (extractBase64) import Data.ByteString.Base64.URL (encodeBase64Unpadded) import OpenSSL.X509 (writeDerX509) import Crypto.Hash.SHA256 (hashlazy)@@ -56,8 +57,7 @@ type App = RouteT (ReaderT Context IO) main :: IO ()-main = do- conn <- SQL.open "gemini-textboard.db"+main = SQL.withConnection "gemini-textboard.db" $ \conn -> do createTables conn nonceGen <- Nonce.new nonceCache <- Cache.newCache $ Just $ TimeSpec 300 0@@ -75,10 +75,10 @@ createTables :: SQL.Connection -> IO () createTables conn = do SQL.execute_ conn $ "CREATE TABLE IF NOT EXISTS posts " <>- "(id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, " <>+ -- NOTE: AUTOINCREMENT here is important: it prevents the reuse of deleted ids+ "(id INTEGER PRIMARY KEY AUTOINCREMENT, " <> "parent INTEGER, content TEXT NOT NULL, author TEXT, time TEXT NOT NULL, " <>- "FOREIGN KEY(parent) REFERENCES posts(id))"- SQL.execute_ conn "CREATE UNIQUE INDEX IF NOT EXISTS post_id_index ON posts (id)"+ "FOREIGN KEY(parent) REFERENCES posts(id) ON DELETE CASCADE)" SQL.execute_ conn "CREATE INDEX IF NOT EXISTS post_parent_index ON posts (parent)" SQL.execute_ conn "CREATE INDEX IF NOT EXISTS post_time_index ON posts (time)" @@ -115,10 +115,11 @@ conn <- db <$> lift ask now <- liftIO getCurrentTime author <- getAuthor- liftIO $ SQL.execute conn- "INSERT INTO posts (parent, content, author, time) VALUES (NULL,?,?,?)"- (content, author, now)- fmap fromIntegral $ liftIO $ SQL.lastInsertRowId conn --TODO non thread safe?+ liftIO $ SQL.withTransaction conn $ do+ SQL.execute conn+ "INSERT INTO posts (parent, content, author, time) VALUES (NULL,?,?,?)"+ (content, author, now)+ fromIntegral <$> SQL.lastInsertRowId conn insertReply :: PostId -> String -> App () insertReply threadId content = do@@ -154,7 +155,7 @@ -- Huge hack, but it works reasonably well. -- Ideally one should only hash the pk parameters. der <- liftIO $ writeDerX509 c- pure $ encodeBase64Unpadded $ hashlazy der+ pure $ extractBase64 $ encodeBase64Unpadded $ hashlazy der -- Handlers -----------@@ -237,7 +238,7 @@ pure $ redirect $ fromJust $ parseRelativeReference $ "/thread/" <> show threadId robotsTxt :: App Response-robotsTxt = pure $ okGemini $ encodeUtf8+robotsTxt = pure $ okPlain $ encodeUtf8 "User-agent: *\n\ \# Do not crawl submission pages\n\ \Disallow: /post/\n\
gemini-textboard.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: gemini-textboard-version: 0.2.0.1+version: 0.2.0.2 synopsis: A barebones textboard for the Gemini protocol -- description: homepage: https://sr.ht/~fgaz/haskell-gemini/@@ -21,8 +21,7 @@ executable gemini-textboard main-is: Main.hs other-extensions: OverloadedStrings- build-depends: base ^>=4.12.0.0 || ^>=4.13.0.0 || ^>=4.14.0.0- -- blocked on sqlite-simple || ^>=4.15.0.0+ build-depends: base >=4.14 && <4.22 , gemini-server ^>=0.3.0.0 , gemini-router ^>=0.1.1.0 , language-gemini ^>=0.1.0.0@@ -30,12 +29,12 @@ , cache ^>=0.1.3.0 , sqlite-simple ^>=0.4.18.0 , clock ^>=0.8- , text ^>=1.2.3.2- , time ^>=1.9.3 || ^>=1.10+ , text ^>=1.2.3.2 || ^>=2.0 || ^>=2.1+ , time ^>=1.9.3 || ^>=1.10 || ^>=1.11 || ^>=1.12 || ^>=1.14 , network-uri ^>=2.6.3.0 || ^>=2.7.0.0- , transformers ^>=0.5.6.2+ , transformers ^>=0.5.6.2 || ^>=0.6 , cryptohash-sha256 ^>=0.11.102- , base64 ^>=0.4.2+ , base64 ^>=1.0 , HsOpenSSL ^>=0.11.5.1 hs-source-dirs: app ghc-options: -Wall -threaded