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).

config/settings-default.yaml

@@ -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
 ###############################################################################

src/Vervis/ActorKey.hs

@@ -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

src/Vervis/Application.hs

@@ -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
 

src/Vervis/Foundation.hs

@@ -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

src/Vervis/Settings.hs

@@ -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

stack.yaml

@@ -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.,

update-deps.sh

@@ -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

vervis.cabal

@@ -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'