Periodically rotated AP actor key for signing ActivityPub requests

The actor key will be used for all actors on the server. It's held in a `TVar`
so that it can always be safely updated and safely retrieved (technically there
is a single writer so IORef and MVar could work, but they require extra care
while TVar is by design suited for this sort of thing).
This commit is contained in:
fr33domlover 2019-01-14 22:08:44 +00:00
parent adaa920aa4
commit 499e26db48
8 changed files with 115 additions and 4 deletions

View file

@ -33,6 +33,17 @@ client-session-timeout:
amount: 2
unit: hours
# Maximal accepted time difference between request date and current time, when
# performing this check during HTTP signature verification
request-time-limit:
amount: 5
unit: seconds
# How often to generate a new actor key for HTTP-signing requests
actor-key-rotation:
amount: 1
unit: hours
###############################################################################
# Development
###############################################################################

73
src/Vervis/ActorKey.hs Normal file
View file

@ -0,0 +1,73 @@
{- 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 Vervis.ActorKey
( ActorKey ()
, generateActorKey
, actorKeyRotator
, actorPublicKey
)
where
import Prelude
import Control.Concurrent (threadDelay)
import Control.Concurrent.STM (TVar, writeTVar)
import Control.Monad (forever)
import Control.Monad.STM (atomically)
import Crypto.PubKey.Ed25519
import Data.ByteArray (convert)
import Data.ByteString (ByteString)
import Data.Time.Interval (TimeInterval, microseconds)
import Data.PEM
-- | Ed25519 signing key.
data ActorKey = ActorKey
{ actorKeySecret :: SecretKey
, actorKeyPublic :: PublicKey
, actorKeyPublicPem :: ByteString
}
-- | Generate a new random key.
generateActorKey :: IO ActorKey
generateActorKey = mk <$> generateSecretKey
where
mk secret =
let public = toPublic secret
in ActorKey
{ actorKeySecret = secret
, actorKeyPublic = public
, actorKeyPublicPem =
pemWriteBS $ PEM "PUBLIC KEY" [] $ convert public
}
-- | A loop that runs forever and periodically generates a new actor key,
-- storing it in a 'TVar'.
actorKeyRotator :: TimeInterval -> TVar ActorKey -> IO ()
actorKeyRotator interval key =
let micros = microseconds interval
in if 0 < micros && micros <= toInteger (maxBound :: Int)
then
let micros' = fromInteger micros
in forever $ do
threadDelay micros'
generateActorKey >>= atomically . writeTVar key
else
error $
"actorKeyRotator: interval out of range: " ++ show micros
-- | The public key in PEM format, can be directly placed in responses.
actorPublicKey :: ActorKey -> ByteString
actorPublicKey = actorKeyPublicPem

View file

@ -108,6 +108,8 @@ makeFoundation appSettings = do
then lin2
else loadFont "data/LinLibertineCut.svg"
appActorKey <- newTVarIO =<< generateActorKey
-- We need a log function to create a connection pool. We need a connection
-- pool to create our foundation. And we need our foundation to get a
-- logging function. To get out of this loop, we initially create a
@ -193,6 +195,10 @@ getAppSettings = loadAppSettings [configSettingsYml] [] useEnv
develMain :: IO ()
develMain = develMainHelper getApplicationDev
actorKeyPeriodicRotator :: App -> IO ()
actorKeyPeriodicRotator app =
actorKeyRotator (appActorKeyRotation $ appSettings app) (appActorKey app)
sshServer :: App -> IO ()
sshServer foundation =
runSsh
@ -231,6 +237,9 @@ appMain = do
-- Generate a WAI Application from the foundation
app <- makeApplication foundation
-- Run actor signature key periodic generation thread
forkCheck $ actorKeyPeriodicRotator foundation
-- Run SSH server
forkCheck $ sshServer foundation

View file

@ -1,6 +1,6 @@
{- This file is part of Vervis.
-
- Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
- Written in 2016, 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
-
- Copying is an act of love. Please copy, reuse and share.
-
@ -44,6 +44,7 @@ import Data.Text as T (pack, intercalate, concat)
--import qualified Data.Text.Encoding as TE
import Text.Jasmine.Local (discardm)
import Vervis.ActorKey (ActorKey)
import Vervis.Import.NoFoundation hiding (Handler, Day, last, init)
import Vervis.Model.Group
import Vervis.Model.Ident
@ -63,6 +64,7 @@ data App = App
, appLogger :: Logger
, appMailQueue :: Maybe (Chan (MailRecipe App))
, appSvgFont :: PreparedFont Double
, appActorKey :: TVar ActorKey
}
-- This is where we define all of the routes in our application. For a full

View file

@ -1,6 +1,6 @@
{- This file is part of Vervis.
-
- Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
- Written in 2016, 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
-
- Copying is an act of love. Please copy, reuse and share.
-
@ -66,6 +66,12 @@ data AppSettings = AppSettings
-- | Idle timeout for session cookie expiration
, appClientSessionTimeout :: TimeInterval
-- Maximal accepted difference between current time and Date header
, appHttpSigTimeLimit :: TimeInterval
-- How often to generate a new actor key for making HTTP signatures
, appActorKeyRotation :: TimeInterval
-- | Use detailed request logging system
, appDetailedRequestLogging :: Bool
-- | Should all log messages be displayed?
@ -116,6 +122,9 @@ instance FromJSON AppSettings where
appClientSessionKeyFile <- o .: "client-session-key"
appClientSessionTimeout <- interval <$> o .: "client-session-timeout"
appHttpSigTimeLimit <- interval <$> o .: "request-time-limit"
appActorKeyRotation <- interval <$> o .: "actor-key-rotation"
appDetailedRequestLogging <- o .:? "detailed-logging" .!= defaultDev
appShouldLogAll <- o .:? "should-log-all" .!= defaultDev
appReloadTemplates <- o .:? "reload-templates" .!= defaultDev

View file

@ -18,6 +18,7 @@ packages:
- lib/hit-graph
- lib/hit-harder
- lib/hit-network
- lib/http-signature
- lib/persistent-migration
- lib/persistent-email-address
- lib/time-interval-aeson
@ -26,6 +27,7 @@ packages:
git: https://dev.angeley.es/s/fr33domlover/r/yesod-auth-account
commit: c14795264c3d63b2126e91e98107a631405cea74
extra-dep: true
- lib/yesod-http-signature
- lib/yesod-mail-send
# Packages to be pulled from upstream that are not in the resolver (e.g.,

View file

@ -7,10 +7,12 @@ DEPS='hit-graph
hit-network
darcs-lights
darcs-rev
http-signature
ssh
persistent-migration
persistent-email-address
time-interval-aeson
yesod-http-signature
yesod-mail-send'
mkdir -p lib

View file

@ -97,6 +97,7 @@ library
Yesod.SessionEntity
Vervis.ActivityStreams
Vervis.ActorKey
Vervis.Application
Vervis.Avatar
Vervis.BinaryBody
@ -224,7 +225,6 @@ library
, colour
, conduit
, containers
-- for SHA1 hashing when parsing Darcs patch metadata
, cryptonite
-- for Storage.Hashed because hashed-storage seems
-- unmaintained and darcs has its own copy
@ -264,9 +264,9 @@ library
--, hjsmin
-- 'git' uses it for 'GitTime'
, hourglass
, yesod-http-signature
, http-types
, libravatar
-- for converting Darcs patch hash Digest to ByteString
, memory
, mime-mail
, monad-control
@ -279,6 +279,7 @@ library
-- for PathPiece instance for CI, Web.PathPieces.Local
, path-pieces
, patience
, pem
, persistent
, persistent-email-address
, persistent-migration
@ -293,6 +294,8 @@ library
, skylighting
, smtp-mail
, ssh
-- for holding actor key in a TVar
, stm
-- for rendering diagrams
, svg-builder
-- for text drawing in 'diagrams'