ActivityPub inbox test page
This patch includes some ugliness and commented out code. Sorry for that. I'll clean it up soon. Basically there's a TVar holding a Vector of at most 10 AP activities. You can freely POST stuff to /inbox, and then GET /inbox and see what you posted, or an error description saying why your activity was rejected.
This commit is contained in:
fr33domlover
parent
e22d0c000a
commit
df01560ea6
7 changed files with 361 additions and 30 deletions
|
|
@ -1,6 +1,6 @@
|
|||
-- This file is part of Vervis.
|
||||
--
|
||||
-- Written in 2016 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.
|
||||
--
|
||||
|
|
@ -20,6 +20,12 @@
|
|||
/favicon.ico FaviconR GET
|
||||
/robots.txt RobotsR GET
|
||||
|
||||
-- ----------------------------------------------------------------------------
|
||||
-- Federation
|
||||
-- ----------------------------------------------------------------------------
|
||||
|
||||
/inbox InboxR GET POST
|
||||
|
||||
-- ----------------------------------------------------------------------------
|
||||
-- Current user
|
||||
-- ----------------------------------------------------------------------------
|
||||
|
|
|
|||
146
src/Vervis/ActivityPub.hs
Normal file
146
src/Vervis/ActivityPub.hs
Normal file
|
|
@ -0,0 +1,146 @@
|
|||
{- 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.ActivityPub
|
||||
( ActorType (..)
|
||||
, Algorithm (..)
|
||||
, PublicKey (..)
|
||||
, Actor (..)
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types (Parser)
|
||||
import Data.PEM
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
|
||||
import Network.URI
|
||||
|
||||
import qualified Data.Text as T (unpack)
|
||||
import qualified Data.Vector as V (fromList)
|
||||
|
||||
frg :: Text
|
||||
frg = "https://forgefed.angeley.es/ns#"
|
||||
|
||||
context :: Value
|
||||
context = Array $ V.fromList
|
||||
[ String "https://www.w3.org/ns/activitystreams"
|
||||
, String "https://w3id.org/security/v1"
|
||||
]
|
||||
|
||||
parseURI' :: Text -> Parser URI
|
||||
parseURI' t =
|
||||
case parseURI $ T.unpack t of
|
||||
Nothing -> fail "Invalid absolute URI"
|
||||
Just u ->
|
||||
if uriScheme u == "https:"
|
||||
then return u
|
||||
else fail "URI scheme isn't https"
|
||||
|
||||
renderURI :: URI -> String
|
||||
renderURI u = uriToString id u ""
|
||||
|
||||
data ActorType = ActorTypePerson | ActorTypeOther Text
|
||||
|
||||
instance FromJSON ActorType where
|
||||
parseJSON = withText "ActorType" $ \ t ->
|
||||
pure $ case t of
|
||||
"Person" -> ActorTypePerson
|
||||
_ -> ActorTypeOther t
|
||||
|
||||
instance ToJSON ActorType where
|
||||
toJSON = error "toJSON ActorType"
|
||||
toEncoding at =
|
||||
toEncoding $ case at of
|
||||
ActorTypePerson -> "Person"
|
||||
ActorTypeOther t -> t
|
||||
|
||||
data Algorithm = AlgorithmEd25519 | AlgorithmOther Text
|
||||
|
||||
instance FromJSON Algorithm where
|
||||
parseJSON = withText "Algorithm" $ \ t ->
|
||||
pure $ if t == frg <> "ed25519"
|
||||
then AlgorithmEd25519
|
||||
else AlgorithmOther t
|
||||
|
||||
instance ToJSON Algorithm where
|
||||
toJSON = error "toJSON Algorithm"
|
||||
toEncoding algo =
|
||||
toEncoding $ case algo of
|
||||
AlgorithmEd25519 -> frg <> "ed25519"
|
||||
AlgorithmOther t -> t
|
||||
|
||||
data PublicKey = PublicKey
|
||||
{ publicKeyId :: URI
|
||||
, publicKeyOwner :: URI
|
||||
, publicKeyPem :: PEM
|
||||
, publicKeyAlgo :: Maybe Algorithm
|
||||
}
|
||||
|
||||
instance FromJSON PublicKey where
|
||||
parseJSON = withObject "PublicKey" $ \ o ->
|
||||
PublicKey
|
||||
<$> (parseURI' =<< o .: "id")
|
||||
<*> (parseURI' =<< o .: "owner")
|
||||
<*> (parsePEM =<< o .: "publicKeyPem")
|
||||
<*> o .:? (frg <> "algorithm")
|
||||
where
|
||||
parsePEM t =
|
||||
case pemParseBS $ encodeUtf8 t of
|
||||
Left e -> fail $ "PEM parsing failed: " ++ e
|
||||
Right xs ->
|
||||
case xs of
|
||||
[] -> fail "Empty PEM"
|
||||
[x] -> pure x
|
||||
_ -> fail "Multiple PEM sections"
|
||||
|
||||
instance ToJSON PublicKey where
|
||||
toJSON = error "toJSON PublicKey"
|
||||
toEncoding (PublicKey id_ owner pem malgo) =
|
||||
pairs
|
||||
$ "id" .= renderURI id_
|
||||
<> "owner" .= renderURI owner
|
||||
<> "publicKeyPem" .= decodeUtf8 (pemWriteBS pem)
|
||||
<> maybe mempty ((frg <> "algorithm") .=) malgo
|
||||
|
||||
data Actor = Actor
|
||||
{ actorId :: URI
|
||||
, actorType :: ActorType
|
||||
, actorUsername :: Text
|
||||
, actorInbox :: URI
|
||||
, actorPublicKey :: PublicKey
|
||||
}
|
||||
|
||||
instance FromJSON Actor where
|
||||
parseJSON = withObject "Actor" $ \ o ->
|
||||
Actor
|
||||
<$> (parseURI' =<< o .: "id")
|
||||
<*> o .: "type"
|
||||
<*> o .: "preferredUsername"
|
||||
<*> (parseURI' =<< o .: "inbox")
|
||||
<*> o .: "publicKey"
|
||||
|
||||
instance ToJSON Actor where
|
||||
toJSON = error "toJSON Actor"
|
||||
toEncoding (Actor id_ typ username inbox pkey) =
|
||||
pairs
|
||||
$ "@context" .= context
|
||||
<> "id" .= renderURI id_
|
||||
<> "type" .= typ
|
||||
<> "preferredUsername" .= username
|
||||
<> "inbox" .= renderURI inbox
|
||||
<> "publicKey" .= pkey
|
||||
|
|
@ -17,7 +17,7 @@ module Vervis.ActorKey
|
|||
( ActorKey ()
|
||||
, generateActorKey
|
||||
, actorKeyRotator
|
||||
, actorPublicKey
|
||||
-- , actorPublicKey
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -33,13 +33,91 @@ import Data.ByteString (ByteString)
|
|||
import Data.Time.Interval (TimeInterval, microseconds)
|
||||
import Data.PEM
|
||||
|
||||
-- | Ed25519 signing key.
|
||||
-- | 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
|
||||
-- signatures.
|
||||
data ActorKey = ActorKey
|
||||
{ actorKeySecret :: SecretKey
|
||||
, actorKeyPublic :: PublicKey
|
||||
, actorKeyPublicPem :: ByteString
|
||||
{ actorKeySecret :: SecretKey
|
||||
-- ^ Secret key in binary form.
|
||||
, actorKeyPublic :: PublicKey
|
||||
-- ^ Public key in binary form.
|
||||
, actorKeyPubPEM :: ByteString
|
||||
-- ^ Public key in PEM format. This can be generated from the binary
|
||||
-- form, but we keep it here because it's used for sending the public
|
||||
-- key to whoever wishes to verify our signatures. So, we generate a
|
||||
-- key once and potentially send the PEM many times.
|
||||
}
|
||||
|
||||
{-
|
||||
-- | Ed25519 public key for signature verification. We receive these public
|
||||
-- keys from other servers and we use them to verify HTTP request signatures.
|
||||
data ActorPublicKey = ActorPublicKey
|
||||
{ actorPublicKeyBin :: PublicKey
|
||||
-- ^ Public key in binary form. This is used for signature verification.
|
||||
, actorPublicKeyPem :: ByteString
|
||||
-- ^ Public key in PEM format. We can use it for formatting the key as
|
||||
-- JSON, and generally into textual formats.
|
||||
, actorPublicKeyId :: URI
|
||||
-- ^ Public key ID URI. We can use it for formatting the key as JSON or
|
||||
-- other textual formats, and for verifying that it's identical to the
|
||||
-- URI we used for retrieving the key.
|
||||
, actorPublicKeyActor :: URI
|
||||
-- ^ Public key's actor URI. We can use it for formatting the key as JSON
|
||||
-- or other textual formats, and for verifying that it's identical to
|
||||
-- the actor ID through which we found the key. We can also check that
|
||||
-- this ID matches the actor ID to which content is attributed, to make
|
||||
-- sure we don't accept content claimed to be authored by someone other
|
||||
-- than the actor who signed the request.
|
||||
}
|
||||
|
||||
instance FromJSON ActorPublicKey where
|
||||
parseJSON = withObject "ActorPublicKey" $ \ o -> do
|
||||
pem <- o .: "publicKeyPem"
|
||||
ActorPublicKey
|
||||
<$> parsePEM pem
|
||||
<*> pure pem
|
||||
<*> parseURI' =<< (o .: "id" <|> o .: "@id")
|
||||
<*> parseURI' =<< o .: "owner"
|
||||
where
|
||||
parsePEM b =
|
||||
case pemParseBS b of
|
||||
Left e -> fail $ "PEM parsing failed: " ++ e
|
||||
Right xs ->
|
||||
case xs of
|
||||
[] -> fail "Empty PEM"
|
||||
[x] ->
|
||||
case publickey $ pemContent x of
|
||||
CryptoPassed k -> return k
|
||||
CryptoFailed e -> fail $ show e
|
||||
_ -> fail "Multiple PEM sections"
|
||||
parseURI' t =
|
||||
withText "URI" $ \ t ->
|
||||
case parseURI $ T.unpack t of
|
||||
Nothing -> fail "Invalid absolute URI"
|
||||
Just u ->
|
||||
if uriScheme u == "https:"
|
||||
then return u
|
||||
else fail "URI scheme isn't https"
|
||||
|
||||
instance ToJSON ActorPublicKey where
|
||||
toJSON = error "toJSON ActorPublicKey"
|
||||
toEncoding (ActorPublicKey _ pem keyid actor) =
|
||||
pairs
|
||||
$ "id" .= showURI keyid
|
||||
<> "owner" .= showURI actor
|
||||
<> "publicKeyPem" .= pem
|
||||
where
|
||||
showURI u = uriToString id u ""
|
||||
{-
|
||||
array = Array . V.fromList
|
||||
context =
|
||||
array
|
||||
[ String "https://w3id.org/security/v1"
|
||||
, object [("id", String "@id")]
|
||||
]
|
||||
-}
|
||||
-}
|
||||
|
||||
-- | Generate a new random key.
|
||||
generateActorKey :: IO ActorKey
|
||||
generateActorKey = mk <$> generateSecretKey
|
||||
|
|
@ -47,11 +125,12 @@ generateActorKey = mk <$> generateSecretKey
|
|||
mk secret =
|
||||
let public = toPublic secret
|
||||
in ActorKey
|
||||
{ actorKeySecret = secret
|
||||
, actorKeyPublic = public
|
||||
, actorKeyPublicPem =
|
||||
pemWriteBS $ PEM "PUBLIC KEY" [] $ convert public
|
||||
{ actorKeySecret = secret
|
||||
, actorKeyPublic = public
|
||||
, actorKeyPubPEM = renderPEM public
|
||||
}
|
||||
renderPEM :: PublicKey -> ByteString
|
||||
renderPEM = pemWriteBS . PEM "PUBLIC KEY" [] . convert
|
||||
|
||||
-- | A loop that runs forever and periodically generates a new actor key,
|
||||
-- storing it in a 'TVar'.
|
||||
|
|
@ -69,5 +148,5 @@ actorKeyRotator interval key =
|
|||
"actorKeyRotator: interval out of range: " ++ show micros
|
||||
|
||||
-- | The public key in PEM format, can be directly placed in responses.
|
||||
actorPublicKey :: ActorKey -> ByteString
|
||||
actorPublicKey = actorKeyPublicPem
|
||||
--actorPublicKey :: ActorKey -> ByteString
|
||||
--actorPublicKey = actorKeyPublicPem
|
||||
|
|
|
|||
|
|
@ -37,6 +37,8 @@ import Graphics.SVGFonts.Fonts (lin2)
|
|||
import Graphics.SVGFonts.ReadFont (loadFont)
|
||||
import Vervis.Import
|
||||
import Language.Haskell.TH.Syntax (qLocation)
|
||||
import Network.HTTP.Client (newManager)
|
||||
import Network.HTTP.Client.TLS (tlsManagerSettings)
|
||||
import Network.Wai (Middleware)
|
||||
import Network.Wai.Handler.Warp (Settings, defaultSettings,
|
||||
defaultShouldDisplayException,
|
||||
|
|
@ -63,6 +65,7 @@ import Vervis.Handler.Common
|
|||
import Vervis.Handler.Git
|
||||
import Vervis.Handler.Group
|
||||
import Vervis.Handler.Home
|
||||
import Vervis.Handler.Inbox
|
||||
import Vervis.Handler.Key
|
||||
import Vervis.Handler.Person
|
||||
import Vervis.Handler.Project
|
||||
|
|
@ -92,7 +95,7 @@ makeFoundation :: AppSettings -> IO App
|
|||
makeFoundation appSettings = do
|
||||
-- Some basic initializations: HTTP connection manager, logger, and static
|
||||
-- subsite.
|
||||
--appHttpManager <- newManager tlsManagerSettings
|
||||
appHttpManager <- newManager tlsManagerSettings
|
||||
appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
|
||||
appStatic <-
|
||||
(if appMutableStatic appSettings then staticDevel else static)
|
||||
|
|
@ -110,6 +113,8 @@ makeFoundation appSettings = do
|
|||
|
||||
appActorKey <- newTVarIO =<< generateActorKey
|
||||
|
||||
appActivities <- newTVarIO mempty
|
||||
|
||||
-- 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
|
||||
|
|
|
|||
|
|
@ -17,12 +17,18 @@ module Vervis.Foundation where
|
|||
|
||||
import Prelude (init, last)
|
||||
|
||||
import Control.Monad.Logger (logWarn)
|
||||
import Control.Monad.Logger.CallStack (logWarn)
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Data.Time.Interval (fromTimeUnit, toTimeUnit)
|
||||
import Data.Time.Units (Minute, Day)
|
||||
import Crypto.Error (CryptoFailable (..))
|
||||
import Crypto.PubKey.Ed25519 (publicKey, signature, verify)
|
||||
import Data.PEM (pemContent)
|
||||
import Data.Time.Interval (TimeInterval, fromTimeUnit, toTimeUnit)
|
||||
import Data.Time.Units (Second, Minute, Day)
|
||||
import Database.Persist.Sql (ConnectionPool, runSqlPool)
|
||||
import Graphics.SVGFonts.ReadFont (PreparedFont)
|
||||
import Network.HTTP.Client (Manager, HttpException, requestFromURI)
|
||||
import Network.HTTP.Simple (httpJSONEither, getResponseBody)
|
||||
import Network.URI (uriFragment, parseURI)
|
||||
import Text.Shakespeare.Text (textFile)
|
||||
import Text.Hamlet (hamletFile)
|
||||
--import Text.Jasmine (minifym)
|
||||
|
|
@ -32,20 +38,27 @@ import Yesod.Auth.Message (AuthMessage (IdentifierNotFound))
|
|||
import Yesod.Core.Types (Logger)
|
||||
import Yesod.Default.Util (addStaticContentExternal)
|
||||
|
||||
import Text.Email.Local
|
||||
|
||||
import Yesod.Auth.Unverified
|
||||
import Yesod.Auth.Unverified.Creds
|
||||
import Yesod.Mail.Send
|
||||
|
||||
import qualified Data.ByteString.Char8 as BC (unpack)
|
||||
import qualified Data.ByteString.Lazy as BL (ByteString)
|
||||
import qualified Yesod.Core.Unsafe as Unsafe
|
||||
--import qualified Data.CaseInsensitive as CI
|
||||
import Data.Text as T (pack, intercalate, concat)
|
||||
--import qualified Data.Text.Encoding as TE
|
||||
|
||||
import Text.Email.Local
|
||||
|
||||
import Network.HTTP.Signature hiding (Algorithm (..))
|
||||
import Yesod.Auth.Unverified
|
||||
import Yesod.Auth.Unverified.Creds
|
||||
import Yesod.HttpSignature (YesodHttpSig (..))
|
||||
import Yesod.Mail.Send
|
||||
|
||||
import qualified Network.HTTP.Signature as S (Algorithm (..))
|
||||
|
||||
import Text.Jasmine.Local (discardm)
|
||||
import Vervis.ActivityPub
|
||||
import Vervis.ActorKey (ActorKey)
|
||||
import Vervis.Import.NoFoundation hiding (Handler, Day, last, init)
|
||||
import Vervis.Import.NoFoundation hiding (Handler, Day, last, init, logWarn)
|
||||
import Vervis.Model.Group
|
||||
import Vervis.Model.Ident
|
||||
import Vervis.Model.Role
|
||||
|
|
@ -60,11 +73,13 @@ data App = App
|
|||
{ appSettings :: AppSettings
|
||||
, appStatic :: Static -- ^ Settings for static file serving.
|
||||
, appConnPool :: ConnectionPool -- ^ Database connection pool.
|
||||
--, appHttpManager :: Manager
|
||||
, appHttpManager :: Manager
|
||||
, appLogger :: Logger
|
||||
, appMailQueue :: Maybe (Chan (MailRecipe App))
|
||||
, appSvgFont :: PreparedFont Double
|
||||
, appActorKey :: TVar ActorKey
|
||||
|
||||
, appActivities :: TVar (Vector (UTCTime, Either String (ByteString, BL.ByteString)))
|
||||
}
|
||||
|
||||
-- This is where we define all of the routes in our application. For a full
|
||||
|
|
@ -272,7 +287,7 @@ instance Yesod App where
|
|||
if username p == uname
|
||||
then return Authorized
|
||||
else do
|
||||
$logWarn $ T.concat
|
||||
logWarn $ T.concat
|
||||
[ "User ", username p, " tried to verify user ", uname
|
||||
]
|
||||
return $ Unauthorized "You can't verify other users"
|
||||
|
|
@ -286,7 +301,7 @@ instance Yesod App where
|
|||
if username p == uname
|
||||
then return Authorized
|
||||
else do
|
||||
$logWarn $ T.concat
|
||||
logWarn $ T.concat
|
||||
[ "User ", username p, " tried to POST to \
|
||||
\verification email resend for user ", uname
|
||||
]
|
||||
|
|
@ -294,7 +309,7 @@ instance Yesod App where
|
|||
Unauthorized
|
||||
"You can't do that for other users"
|
||||
_ -> do
|
||||
$logWarn $ T.concat
|
||||
logWarn $ T.concat
|
||||
[ "User ", username p, " tried to POST to \
|
||||
\verification email resend for invalid username"
|
||||
]
|
||||
|
|
@ -330,7 +345,7 @@ instance Yesod App where
|
|||
meg <- getBy $ UniqueGroup sid
|
||||
case meg of
|
||||
Nothing -> do
|
||||
$logWarn $
|
||||
logWarn $
|
||||
"Found non-person non-group sharer: " <>
|
||||
shr2text shr
|
||||
return $ error "Zombie sharer"
|
||||
|
|
@ -494,7 +509,7 @@ instance AccountSendEmail App where
|
|||
unless sent $ do
|
||||
setMessage "Mail sending disabled, please contact admin"
|
||||
ur <- getUrlRender
|
||||
$logWarn $ T.concat
|
||||
logWarn $ T.concat
|
||||
[ "Verification email NOT SENT for user "
|
||||
, uname, " <", emailText email, ">: "
|
||||
, ur url
|
||||
|
|
@ -504,7 +519,7 @@ instance AccountSendEmail App where
|
|||
unless sent $ do
|
||||
setMessage "Mail sending disabled, please contact admin"
|
||||
ur <- getUrlRender
|
||||
$logWarn $ T.concat
|
||||
logWarn $ T.concat
|
||||
["Password reset email NOT SENT for user "
|
||||
, uname, " <", emailText email, ">: "
|
||||
, ur url
|
||||
|
|
@ -545,6 +560,73 @@ unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
|
|||
-- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain
|
||||
-- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding
|
||||
|
||||
{-
|
||||
instance YesodHttpSig App where
|
||||
data HttpSigVerResult App = HttpSigVerResult Bool
|
||||
httpSigVerHeaders = const [HeaderTarget, HeaderName "Host"]
|
||||
httpSigVerSeconds =
|
||||
fromIntegral . toSeconds . appHttpSigTimeLimit . appSettings
|
||||
where
|
||||
toSeconds :: TimeInterval -> Second
|
||||
toSeconds = toTimeUnit
|
||||
httpVerifySig malgo (KeyId keyid) input (Signature sig) =
|
||||
if algoSupported malgo
|
||||
then case parseURI $ BC.unpack keyid of
|
||||
Just u -> do
|
||||
eres <- try $ httpJSONEither =<< requestFromURI u
|
||||
case eres of
|
||||
Left e -> do
|
||||
logWarn $ "httpVerifySig got HTTP exception: " <> T.pack (displayException (e :: HttpException))
|
||||
-- return HttpSigVerKeyNotFound
|
||||
return $ HttpSigVerResult False
|
||||
Right r ->
|
||||
case getResponseBody r of
|
||||
Left e -> do
|
||||
logWarn $ "httpVerifySig got JSON exception: " <> T.pack (displayException e)
|
||||
-- return HttpSigVerKeyNotFound
|
||||
return $ HttpSigVerResult False
|
||||
Right actor -> do
|
||||
let uActor = u { uriFragment = "" }
|
||||
if uActor == actorId actor
|
||||
then
|
||||
let pkey = actorPublicKey actor
|
||||
in if publicKeyId pkey == u && publicKeyOwner pkey == actorId actor
|
||||
then case publicKeyAlgo pkey of
|
||||
Just AlgorithmEd25519 ->
|
||||
case publicKey $ pemContent $ publicKeyPem pkey of
|
||||
CryptoPassed k ->
|
||||
case signature sig of
|
||||
CryptoPassed s ->
|
||||
return $ if verify k input s
|
||||
then -- HttpSigVerValid
|
||||
HttpSigVerResult True
|
||||
else -- HttpSigVerInvalid
|
||||
HttpSigVerResult False
|
||||
CryptoFailed e -> -- TODO handle
|
||||
return $ HttpSigVerResult False
|
||||
CryptoFailed e -> -- TODO handle
|
||||
return $ HttpSigVerResult False
|
||||
_ -> case malgo of
|
||||
Nothing -> -- return HttpSigVerAlgoNotSupported
|
||||
return $ HttpSigVerResult False
|
||||
Just _ -> -- return HttpSigVerAlgoMismatch
|
||||
return $ HttpSigVerResult False
|
||||
else -- TODO handle the mismatch
|
||||
return $ HttpSigVerResult False
|
||||
else -- TODO actor id doesn't match URL we accessed!
|
||||
return $ HttpSigVerResult False
|
||||
Nothing -> -- return HttpSigVerKeyNotFound
|
||||
return $ HttpSigVerResult False
|
||||
else -- return HttpSigVerAlgoNotSupported
|
||||
return $ HttpSigVerResult False
|
||||
where
|
||||
algoSupported Nothing = True
|
||||
algoSupported (Just a) =
|
||||
case a of
|
||||
S.AlgorithmEd25519 -> True
|
||||
S.AlgorithmOther _ -> False
|
||||
-}
|
||||
|
||||
instance YesodBreadcrumbs App where
|
||||
breadcrumb route = return $ case route of
|
||||
StaticR _ -> ("", Nothing)
|
||||
|
|
|
|||
|
|
@ -23,6 +23,9 @@ $nothing
|
|||
Or
|
||||
<a href=@{AuthR newAccountR}>Sign up.
|
||||
|
||||
<p>
|
||||
UPDATE: Federation is coming! Early testing at @{InboxR}
|
||||
|
||||
^{breadcrumbsW}
|
||||
|
||||
$maybe msg <- mmsg
|
||||
|
|
|
|||
10
vervis.cabal
10
vervis.cabal
|
|
@ -96,6 +96,7 @@ library
|
|||
Yesod.Paginate.Local
|
||||
Yesod.SessionEntity
|
||||
|
||||
Vervis.ActivityPub
|
||||
Vervis.ActivityStreams
|
||||
Vervis.ActorKey
|
||||
Vervis.Application
|
||||
|
|
@ -133,6 +134,7 @@ library
|
|||
Vervis.Handler.Git
|
||||
Vervis.Handler.Group
|
||||
Vervis.Handler.Home
|
||||
Vervis.Handler.Inbox
|
||||
Vervis.Handler.Key
|
||||
Vervis.Handler.Person
|
||||
Vervis.Handler.Project
|
||||
|
|
@ -202,6 +204,8 @@ library
|
|||
TupleSections
|
||||
RecordWildCards
|
||||
build-depends: aeson
|
||||
-- For activity JSOn display in /inbox test page
|
||||
, aeson-pretty
|
||||
-- for parsing commands sent over SSH and Darcs patch
|
||||
-- metadata
|
||||
, attoparsec
|
||||
|
|
@ -256,6 +260,7 @@ library
|
|||
, hashable
|
||||
-- for source file highlighting
|
||||
, highlighter2
|
||||
, http-signature
|
||||
, git
|
||||
, hit-graph
|
||||
, hit-harder
|
||||
|
|
@ -265,6 +270,9 @@ library
|
|||
-- 'git' uses it for 'GitTime'
|
||||
, hourglass
|
||||
, yesod-http-signature
|
||||
, http-client
|
||||
, http-client-tls
|
||||
, http-conduit
|
||||
, http-types
|
||||
, libravatar
|
||||
, memory
|
||||
|
|
@ -274,6 +282,7 @@ library
|
|||
-- for Database.Persist.Local
|
||||
, mtl
|
||||
, network
|
||||
, network-uri
|
||||
, pandoc
|
||||
, pandoc-types
|
||||
-- for PathPiece instance for CI, Web.PathPieces.Local
|
||||
|
|
@ -309,6 +318,7 @@ library
|
|||
, transformers
|
||||
-- probably should be replaced with lenses once I learn
|
||||
, tuple
|
||||
, unliftio
|
||||
, unordered-containers
|
||||
, vector
|
||||
, wai
|
||||
|
|
|
|||
Loading…
Reference in a new issue