diff --git a/src/Vervis/ActorKey.hs b/src/Vervis/ActorKey.hs index e375744..cc0b05d 100644 --- a/src/Vervis/ActorKey.hs +++ b/src/Vervis/ActorKey.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2019 by fr33domlover . + - Written in 2019, 2022 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -23,21 +23,27 @@ module Vervis.ActorKey ) where +import Control.Exception.Base import Control.Concurrent (threadDelay) import Control.Concurrent.STM (TVar, modifyTVar') import Control.Monad (forever) import Control.Monad.STM (atomically) -import Crypto.Error (throwCryptoErrorIO) +import Crypto.Error import Crypto.PubKey.Ed25519 hiding (Signature) +import Data.Bifunctor import Data.ByteArray (convert) import Data.ByteString (ByteString) +import Data.Text (Text) import Data.Time.Interval (TimeInterval, microseconds) import Data.PEM import Data.X509 +import Database.Persist +import Database.Persist.Sql import Network.HTTP.Signature (Signature (..)) import System.Directory (doesFileExist) import qualified Data.ByteString as B (writeFile, readFile) +import qualified Data.Text as T import Crypto.PublicVerifKey import Data.KeyFile @@ -69,6 +75,25 @@ instance KeyFile ActorKey where } renderKey = convert . actorKeySecret +actorKeySecretBin :: ActorKey -> ByteString +actorKeySecretBin = convert . actorKeySecret + +instance PersistField ActorKey where + toPersistValue = toPersistValue . actorKeySecretBin + fromPersistValue v = do + b <- fromPersistValue v :: Either Text ByteString + secret <- bimap showError id $ eitherCryptoError $ secretKey b + return ActorKey + { actorKeySecret = secret + , actorKeyPublic = toPublic secret + } + where + showError e = + "Parsing ActorKey from DB failed: " <> T.pack (displayException e) + +instance PersistFieldSql ActorKey where + sqlType = sqlType . fmap actorKeySecretBin + {- -- | Ed25519 public key for signature verification. We receive these public -- keys from other servers and we use them to verify HTTP request signatures.