Generate and keep permanent salt for generating hashids for URIs
This commit is contained in:
parent
9536d870e5
commit
c2bf470fb6
10 changed files with 190 additions and 40 deletions
|
@ -123,3 +123,6 @@ max-accounts: 3
|
|||
|
||||
# Signing key file for signing object capabilities sent to remote users
|
||||
capability-signing-key: config/capability_signing_key
|
||||
|
||||
# Salt file for encoding and decoding hashids
|
||||
hashids-salt-file: config/hashids_salt
|
||||
|
|
39
src/Data/Int/Local.hs
Normal file
39
src/Data/Int/Local.hs
Normal file
|
@ -0,0 +1,39 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2019 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
- The author(s) have dedicated all copyright and related and neighboring
|
||||
- rights to this software to the public domain worldwide. This software is
|
||||
- distributed without any warranty.
|
||||
-
|
||||
- You should have received a copy of the CC0 Public Domain Dedication along
|
||||
- with this software. If not, see
|
||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
-}
|
||||
|
||||
module Data.Int.Local
|
||||
( toInts
|
||||
, fromInts
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Int (Int64)
|
||||
import Data.List.NonEmpty (NonEmpty (..), (<|))
|
||||
|
||||
modbase :: Int64
|
||||
modbase = 2 ^ 29
|
||||
|
||||
toInts :: Int64 -> NonEmpty Int
|
||||
toInts n =
|
||||
let (d, m) = n `divMod` modbase
|
||||
m' = fromIntegral m
|
||||
in if d == 0
|
||||
then m' :| []
|
||||
else m' <| toInts d
|
||||
|
||||
fromInts :: NonEmpty Int -> Int64
|
||||
fromInts = foldr (\ i n -> fromIntegral i + modbase * n) 0
|
46
src/Data/KeyFile.hs
Normal file
46
src/Data/KeyFile.hs
Normal file
|
@ -0,0 +1,46 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2019 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
- The author(s) have dedicated all copyright and related and neighboring
|
||||
- rights to this software to the public domain worldwide. This software is
|
||||
- distributed without any warranty.
|
||||
-
|
||||
- You should have received a copy of the CC0 Public Domain Dedication along
|
||||
- with this software. If not, see
|
||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
-}
|
||||
|
||||
module Data.KeyFile
|
||||
( KeyFile (..)
|
||||
, loadKeyFile
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
import System.Directory (doesFileExist)
|
||||
|
||||
import qualified Data.ByteString as B (readFile, writeFile)
|
||||
|
||||
class KeyFile a where
|
||||
generateKey :: IO a
|
||||
parseKey :: ByteString -> IO a
|
||||
renderKey :: a -> ByteString
|
||||
|
||||
loadKeyFile :: KeyFile a => Bool -> FilePath -> IO a
|
||||
loadKeyFile setup path = do
|
||||
e <- doesFileExist path
|
||||
if e
|
||||
then if setup
|
||||
then fail $ "loadKeyFile: Initial setup but file already exists: " ++ path
|
||||
else parseKey =<< B.readFile path
|
||||
else if setup
|
||||
then do
|
||||
k <- generateKey
|
||||
B.writeFile path $ renderKey k
|
||||
return k
|
||||
else fail $ "loadKeyFile: File not found: " ++ path
|
|
@ -40,7 +40,7 @@ import System.Directory (doesFileExist)
|
|||
|
||||
import qualified Data.ByteString as B (writeFile, readFile)
|
||||
|
||||
import Vervis.KeyFile
|
||||
import Data.KeyFile
|
||||
|
||||
-- | Ed25519 signing key, we generate it on the server and use for signing. We
|
||||
-- also make its public key available to whoever wishes to verify our
|
||||
|
|
|
@ -59,8 +59,11 @@ import Control.Concurrent.Local (forkCheck)
|
|||
|
||||
import Database.Persist.Schema.PostgreSQL (schemaBackend)
|
||||
|
||||
import Data.KeyFile (loadKeyFile)
|
||||
import Web.Hashids.Local
|
||||
|
||||
import Vervis.ActorKey (generateActorKey, actorKeyRotator)
|
||||
import Vervis.KeyFile (isInitialSetup, loadKeyFile)
|
||||
import Vervis.KeyFile (isInitialSetup)
|
||||
|
||||
-- Import all relevant handler modules here.
|
||||
-- Don't forget to add new modules to your cabal file!
|
||||
|
@ -125,7 +128,12 @@ makeFoundation appSettings = do
|
|||
-- logging function. To get out of this loop, we initially create a
|
||||
-- temporary foundation without a real connection pool, get a log function
|
||||
-- from there, and then create the real foundation.
|
||||
let mkFoundation appConnPool appCapSignKey = App {..}
|
||||
let mkFoundation
|
||||
appConnPool
|
||||
appCapSignKey
|
||||
appHashidEncode
|
||||
appHashidDecode =
|
||||
App {..}
|
||||
-- The App {..} syntax is an example of record wild cards. For more
|
||||
-- information, see:
|
||||
-- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
|
||||
|
@ -133,6 +141,8 @@ makeFoundation appSettings = do
|
|||
mkFoundation
|
||||
(error "connPool forced in tempFoundation")
|
||||
(error "capSignKey forced in tempFoundation")
|
||||
(error "hashidEncode forced in tempFoundation")
|
||||
(error "hashidDecode forced in tempFoundation")
|
||||
logFunc = loggingFunction tempFoundation
|
||||
|
||||
-- Create the database connection pool
|
||||
|
@ -142,6 +152,10 @@ makeFoundation appSettings = do
|
|||
|
||||
setup <- isInitialSetup pool schemaBackend
|
||||
capSignKey <- loadKeyFile setup $ appCapabilitySigningKeyFile appSettings
|
||||
hashidsSalt <- loadKeyFile setup $ appHashidsSaltFile appSettings
|
||||
let hashidsCtx = hashidsContext hashidsSalt
|
||||
hashidEncode = decodeUtf8 . encodeInt64 hashidsCtx
|
||||
hashidDecode = decodeInt64 hashidsCtx . encodeUtf8
|
||||
|
||||
-- Perform database migration using our application's logging settings.
|
||||
--runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
|
||||
|
@ -156,7 +170,7 @@ makeFoundation appSettings = do
|
|||
Right (_from, _to) -> $logInfo "DB migration success"
|
||||
|
||||
-- Return the foundation
|
||||
return $ mkFoundation pool capSignKey
|
||||
return $ mkFoundation pool capSignKey hashidEncode hashidDecode
|
||||
|
||||
-- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
|
||||
-- applying some additional middlewares.
|
||||
|
|
|
@ -85,6 +85,8 @@ data App = App
|
|||
, appSvgFont :: PreparedFont Double
|
||||
, appActorKeys :: TVar (ActorKey, ActorKey, Bool)
|
||||
, appCapSignKey :: ActorKey
|
||||
, appHashidEncode :: Int64 -> Text
|
||||
, appHashidDecode :: Text -> Maybe Int64
|
||||
|
||||
, appActivities :: TVar (Vector (UTCTime, Either String (ByteString, BL.ByteString)))
|
||||
}
|
||||
|
|
|
@ -33,50 +33,26 @@
|
|||
-- * Have a reliable way to determine whether we're in the initial setup
|
||||
-- step, and make sure it's not easy to accidentally break this detection
|
||||
--
|
||||
-- This module implements such a mechanism for Vervis. It's really simple:
|
||||
-- This module, along with "Data.KeyFile", implements such a mechanism for
|
||||
-- Vervis. It's really simple:
|
||||
--
|
||||
-- * If there are no tables in the DB, it's the initial setup phase
|
||||
-- * If initial setup, require that key file doesn't exist, and generate one
|
||||
-- * If not initial setup, require that key file exists
|
||||
module Vervis.KeyFile
|
||||
( KeyFile (..)
|
||||
, isInitialSetup
|
||||
, loadKeyFile
|
||||
( isInitialSetup
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.Trans.Reader (runReaderT)
|
||||
import Data.ByteString (ByteString)
|
||||
import Database.Persist.Schema (SchemaBackend, hasEntities)
|
||||
import Database.Persist.Schema.SQL ()
|
||||
import Database.Persist.Sql (SqlBackend, ConnectionPool, runSqlPool)
|
||||
import System.Directory (doesFileExist)
|
||||
|
||||
import qualified Data.ByteString as B (readFile, writeFile)
|
||||
|
||||
class KeyFile a where
|
||||
generateKey :: IO a
|
||||
parseKey :: ByteString -> IO a
|
||||
renderKey :: a -> ByteString
|
||||
|
||||
-- | Check whether we're in the initial setup step, in which we create keys.
|
||||
-- Otherwise, we'll only use existing keys loaded from files.
|
||||
isInitialSetup :: ConnectionPool -> SchemaBackend SqlBackend -> IO Bool
|
||||
isInitialSetup pool sb =
|
||||
flip runSqlPool pool . flip runReaderT sb $ not <$> hasEntities
|
||||
|
||||
loadKeyFile :: KeyFile a => Bool -> FilePath -> IO a
|
||||
loadKeyFile setup path = do
|
||||
e <- doesFileExist path
|
||||
if e
|
||||
then if setup
|
||||
then fail $ "loadKeyFile: Initial setup but file already exists: " ++ path
|
||||
else parseKey =<< B.readFile path
|
||||
else if setup
|
||||
then do
|
||||
k <- generateKey
|
||||
B.writeFile path $ renderKey k
|
||||
return k
|
||||
else fail $ "loadKeyFile: File not found: " ++ path
|
||||
|
|
|
@ -105,6 +105,8 @@ data AppSettings = AppSettings
|
|||
|
||||
-- Signing key file for signing object capabilities sent to remote users
|
||||
, appCapabilitySigningKeyFile :: FilePath
|
||||
-- Salt for encoding and decoding hashids
|
||||
, appHashidsSaltFile :: FilePath
|
||||
}
|
||||
|
||||
instance FromJSON AppSettings where
|
||||
|
@ -145,6 +147,7 @@ instance FromJSON AppSettings where
|
|||
appMail <- o .:? "mail"
|
||||
|
||||
appCapabilitySigningKeyFile <- o .: "capability-signing-key"
|
||||
appHashidsSaltFile <- o .: "hashids-salt-file"
|
||||
|
||||
return AppSettings {..}
|
||||
|
||||
|
|
61
src/Web/Hashids/Local.hs
Normal file
61
src/Web/Hashids/Local.hs
Normal file
|
@ -0,0 +1,61 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2019 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
- The author(s) have dedicated all copyright and related and neighboring
|
||||
- rights to this software to the public domain worldwide. This software is
|
||||
- distributed without any warranty.
|
||||
-
|
||||
- You should have received a copy of the CC0 Public Domain Dedication along
|
||||
- with this software. If not, see
|
||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
-}
|
||||
|
||||
module Web.Hashids.Local
|
||||
( hashidsContext
|
||||
, encodeInt64
|
||||
, decodeInt64
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad (replicateM)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Int (Int64)
|
||||
import Data.List.NonEmpty (nonEmpty)
|
||||
import System.Random (randomIO)
|
||||
import Web.Hashids
|
||||
|
||||
import qualified Data.ByteString as B (pack, length)
|
||||
import qualified Data.List.NonEmpty as NE (toList)
|
||||
|
||||
import Data.Int.Local
|
||||
import Data.KeyFile
|
||||
|
||||
saltLength :: Int
|
||||
saltLength = 32
|
||||
|
||||
newtype HashidsSalt = HashidsSalt ByteString
|
||||
|
||||
instance KeyFile HashidsSalt where
|
||||
generateKey = HashidsSalt <$> generateRandomBytes saltLength
|
||||
where
|
||||
generateRandomBytes :: Int -> IO ByteString
|
||||
generateRandomBytes n = B.pack <$> replicateM n randomIO
|
||||
parseKey b =
|
||||
if B.length b == saltLength
|
||||
then return $ HashidsSalt b
|
||||
else fail "parseKey HashidsSalt: Invalid length"
|
||||
renderKey (HashidsSalt b) = b
|
||||
|
||||
hashidsContext :: HashidsSalt -> HashidsContext
|
||||
hashidsContext = flip hashidsMinimum 5 . renderKey
|
||||
|
||||
encodeInt64 :: HashidsContext -> Int64 -> ByteString
|
||||
encodeInt64 c = encodeList c . NE.toList . toInts
|
||||
|
||||
decodeInt64 :: HashidsContext -> ByteString -> Maybe Int64
|
||||
decodeInt64 c = fmap fromInts . nonEmpty . decode c
|
|
@ -60,6 +60,8 @@ library
|
|||
Data.Graph.Inductive.Query.TransRed
|
||||
Data.HashMap.Lazy.Local
|
||||
Data.Hourglass.Local
|
||||
Data.Int.Local
|
||||
Data.KeyFile
|
||||
Data.List.Local
|
||||
Data.Maybe.Local
|
||||
Data.Paginate.Local
|
||||
|
@ -84,6 +86,7 @@ library
|
|||
Text.FilePath.Local
|
||||
Text.Jasmine.Local
|
||||
Web.ActivityPub
|
||||
Web.Hashids.Local
|
||||
Web.PathPieces.Local
|
||||
Yesod.Auth.Unverified
|
||||
Yesod.Auth.Unverified.Creds
|
||||
|
@ -256,6 +259,7 @@ library
|
|||
, filepath
|
||||
, formatting
|
||||
, hashable
|
||||
, hashids
|
||||
-- for source file highlighting
|
||||
, highlighter2
|
||||
, http-client-signature
|
||||
|
@ -295,6 +299,8 @@ library
|
|||
, persistent-postgresql
|
||||
, persistent-template
|
||||
, process
|
||||
-- for generating hashids salt
|
||||
, random
|
||||
-- for Database.Persist.Local
|
||||
, resourcet
|
||||
, safe
|
||||
|
|
Loading…
Reference in a new issue