mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-27 15:54:51 +09:00
Federation test outbox page with form for entering JSON
This commit is contained in:
fr33domlover
parent
2cc621e3a5
commit
1f47ca39eb
12 changed files with 632 additions and 190 deletions
|
|
@ -25,6 +25,7 @@
|
|||
-- ----------------------------------------------------------------------------
|
||||
|
||||
/inbox InboxR GET POST
|
||||
/outbox OutboxR GET POST
|
||||
|
||||
-- ----------------------------------------------------------------------------
|
||||
-- Current user
|
||||
|
|
|
|||
46
src/Data/Aeson/Encode/Pretty/ToEncoding.hs
Normal file
46
src/Data/Aeson/Encode/Pretty/ToEncoding.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/>.
|
||||
-}
|
||||
|
||||
-- | A replacement for "Data.Aeson.Encode.Pretty" which uses 'toEncoding'
|
||||
-- instead of 'toJSON'.
|
||||
module Data.Aeson.Encode.Pretty.ToEncoding
|
||||
( encodePretty
|
||||
, encodePrettyToLazyText
|
||||
, encodePrettyToTextBuilder
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Aeson (ToJSON, Value, encode, decode)
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Text.Lazy.Builder (Builder, fromLazyText)
|
||||
import Data.Text.Lazy.Encoding (decodeUtf8)
|
||||
|
||||
import qualified Data.Aeson.Encode.Pretty as P (encodePretty)
|
||||
|
||||
encodePretty :: ToJSON a => a -> ByteString
|
||||
encodePretty = P.encodePretty . fromJust . decodeValue . encode
|
||||
where
|
||||
decodeValue :: ByteString -> Maybe Value
|
||||
decodeValue = decode
|
||||
|
||||
encodePrettyToLazyText :: ToJSON a => a -> Text
|
||||
encodePrettyToLazyText = decodeUtf8 . encodePretty
|
||||
|
||||
encodePrettyToTextBuilder :: ToJSON a => a -> Builder
|
||||
encodePrettyToTextBuilder = fromLazyText . encodePrettyToLazyText
|
||||
104
src/Network/HTTP/Client/Conduit/ActivityPub.hs
Normal file
104
src/Network/HTTP/Client/Conduit/ActivityPub.hs
Normal file
|
|
@ -0,0 +1,104 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
- This file includes HTTP client functions for using http-conduit to receive
|
||||
- ActivityPub JSON objects. The functions here are simply minor adaptations of
|
||||
- functions from the http-conduit package, so technically this module inherits
|
||||
- that package's license and isn't CC0 like most Vervis code.
|
||||
-
|
||||
- Copyright 2010, Michael Snoyman. All rights reserved.
|
||||
- Includes code written in 2019 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- Redistribution and use in source and binary forms, with or without
|
||||
- modification, are permitted provided that the following conditions are met:
|
||||
-
|
||||
- * Redistributions of source code must retain the above copyright notice,
|
||||
- this list of conditions and the following disclaimer.
|
||||
-
|
||||
- * Redistributions in binary form must reproduce the above copyright notice,
|
||||
- this list of conditions and the following disclaimer in the documentation
|
||||
- and/or other materials provided with the distribution.
|
||||
-
|
||||
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS
|
||||
- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
|
||||
- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
|
||||
- NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
|
||||
- OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
|
||||
- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
|
||||
- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
|
||||
- EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
-}
|
||||
|
||||
module Network.HTTP.Client.Conduit.ActivityPub
|
||||
( httpAPEither
|
||||
, httpAP
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Exception (throwIO, bracket)
|
||||
import Control.Monad.IO.Unlift (MonadIO, liftIO, MonadUnliftIO, withRunInIO)
|
||||
import Data.Aeson (FromJSON, Result (..), fromJSON, json')
|
||||
import Data.Conduit (runConduit, (.|), ConduitM)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Conduit.Attoparsec (sinkParserEither)
|
||||
import Data.Void (Void)
|
||||
import Network.HTTP.Client
|
||||
import Network.HTTP.Client.Conduit (bodyReaderSource)
|
||||
import Network.HTTP.Simple
|
||||
import Network.HTTP.Types.Header (hAccept)
|
||||
|
||||
-- | Like 'httpSink' from @http-conduit@, except it takes a 'Manager' instead
|
||||
-- of using a global one.
|
||||
httpSink'
|
||||
:: MonadUnliftIO m
|
||||
=> Manager
|
||||
-> Request
|
||||
-> (Response () -> ConduitM ByteString Void m a)
|
||||
-> m a
|
||||
httpSink' man req sink = withRunInIO $ \ run ->
|
||||
bracket
|
||||
(responseOpen req man)
|
||||
responseClose
|
||||
$ \ res -> run
|
||||
$ runConduit
|
||||
$ bodyReaderSource (getResponseBody res)
|
||||
.| sink (fmap (const ()) res)
|
||||
|
||||
-- | Like 'httpJSONEither' from @http-conduit@, except:
|
||||
--
|
||||
-- * It takes a 'Manager' instead of using a global one
|
||||
-- * It sets the _Accept_ header to the ActivityPub one, not application/json
|
||||
httpAPEither
|
||||
:: (MonadIO m, FromJSON a)
|
||||
=> Manager
|
||||
-> Request
|
||||
-> m (Response (Either JSONException a))
|
||||
httpAPEither man req = liftIO $ httpSink' man req' sink
|
||||
where
|
||||
ct = "application/ld+json; \
|
||||
\profile=\"https://www.w3.org/ns/activitystreams\""
|
||||
req' = addRequestHeader hAccept ct req
|
||||
sink orig = fmap (\ x -> fmap (const x) orig) $ do
|
||||
eres1 <- sinkParserEither json'
|
||||
case eres1 of
|
||||
Left e -> return $ Left $ JSONParseException req' orig e
|
||||
Right value ->
|
||||
case fromJSON value of
|
||||
Error e ->
|
||||
return $ Left $
|
||||
JSONConversionException
|
||||
req'
|
||||
(fmap (const value) orig)
|
||||
e
|
||||
Success x -> return $ Right x
|
||||
|
||||
-- | Like 'httpAPEither', except if JSON parsing fails, a 'JSONException' is
|
||||
-- thrown.
|
||||
httpAP :: (MonadIO m, FromJSON a) => Manager -> Request -> m (Response a)
|
||||
httpAP man req =
|
||||
liftIO $ httpAPEither man req >>= traverse (either throwIO return)
|
||||
|
|
@ -1,164 +0,0 @@
|
|||
{- 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 (..)
|
||||
, provideAP
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.Trans.Writer (Writer)
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types (Parser)
|
||||
import Data.PEM
|
||||
import Data.Semigroup (Endo)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
|
||||
import Network.URI
|
||||
import Yesod.Core.Content (ContentType)
|
||||
import Yesod.Core.Handler (ProvidedRep, provideRepType)
|
||||
|
||||
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
|
||||
|
||||
typeActivityStreams2 :: ContentType
|
||||
typeActivityStreams2 = "application/activity+json"
|
||||
|
||||
typeActivityStreams2LD :: ContentType
|
||||
typeActivityStreams2LD =
|
||||
"application/ld+json; profile=\"https://www.w3.org/ns/activitystreams\""
|
||||
|
||||
provideAP :: (Monad m, ToJSON a) => a -> Writer (Endo [ProvidedRep m]) ()
|
||||
provideAP v = do
|
||||
let enc = toEncoding v
|
||||
provideRepType typeActivityStreams2 $ return enc
|
||||
provideRepType typeActivityStreams2LD $ return enc
|
||||
|
|
@ -18,6 +18,7 @@ module Vervis.ActorKey
|
|||
, generateActorKey
|
||||
, actorKeyRotator
|
||||
, actorKeyPublicBin
|
||||
, actorKeySign
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -27,11 +28,12 @@ import Control.Concurrent (threadDelay)
|
|||
import Control.Concurrent.STM (TVar, writeTVar)
|
||||
import Control.Monad (forever)
|
||||
import Control.Monad.STM (atomically)
|
||||
import Crypto.PubKey.Ed25519
|
||||
import Crypto.PubKey.Ed25519 hiding (Signature)
|
||||
import Data.ByteArray (convert)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Time.Interval (TimeInterval, microseconds)
|
||||
import Data.PEM
|
||||
import Network.HTTP.Signature (Signature (..))
|
||||
|
||||
-- | 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
|
||||
|
|
@ -155,3 +157,6 @@ actorKeyRotator interval key =
|
|||
-- probably okay because the PEM rendering is hopefully trivial.
|
||||
actorKeyPublicBin :: ActorKey -> ByteString
|
||||
actorKeyPublicBin = convert . actorKeyPublic
|
||||
|
||||
actorKeySign :: ActorKey -> ByteString -> Signature
|
||||
actorKeySign (ActorKey sec pub) = Signature . convert . sign sec pub
|
||||
|
|
|
|||
|
|
@ -27,8 +27,9 @@ 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, setRequestManager, addRequestHeader)
|
||||
import Network.HTTP.Client (Manager, HttpException, requestFromURI, responseBody)
|
||||
import Network.HTTP.Simple (httpJSONEither, setRequestManager, addRequestHeader)
|
||||
import Network.HTTP.Types.Header (hHost)
|
||||
import Network.URI (URI (uriFragment), parseURI)
|
||||
import Text.Shakespeare.Text (textFile)
|
||||
import Text.Hamlet (hamletFile)
|
||||
|
|
@ -46,8 +47,6 @@ import qualified Yesod.Core.Unsafe as Unsafe
|
|||
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
|
||||
|
|
@ -56,8 +55,11 @@ import Yesod.Mail.Send
|
|||
|
||||
import qualified Network.HTTP.Signature as S (Algorithm (..))
|
||||
|
||||
import Web.ActivityPub
|
||||
|
||||
import Text.Email.Local
|
||||
import Text.Jasmine.Local (discardm)
|
||||
import Vervis.ActivityPub
|
||||
|
||||
import Vervis.ActorKey (ActorKey)
|
||||
import Vervis.Import.NoFoundation hiding (Handler, Day, last, init, logWarn)
|
||||
import Vervis.Model.Group
|
||||
|
|
@ -170,6 +172,8 @@ instance Yesod App where
|
|||
| a == resendVerifyR -> personFromResendForm
|
||||
(AuthR (PluginR "account" ["verify", u, _]), False) -> personUnver u
|
||||
|
||||
(OutboxR , True) -> personAny
|
||||
|
||||
(GroupsR , True) -> personAny
|
||||
(GroupNewR , _ ) -> personAny
|
||||
(GroupMembersR grp , True) -> groupAdmin grp
|
||||
|
|
@ -563,7 +567,7 @@ unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
|
|||
|
||||
instance YesodHttpSig App where
|
||||
data HttpSigVerResult App = HttpSigVerResult (Either String URI)
|
||||
httpSigVerHeaders = const [HeaderTarget, HeaderName "Host"]
|
||||
httpSigVerHeaders = const [hRequestTarget, hHost]
|
||||
httpSigVerSeconds =
|
||||
fromIntegral . toSeconds . appHttpSigTimeLimit . appSettings
|
||||
where
|
||||
|
|
@ -580,16 +584,8 @@ instance YesodHttpSig App where
|
|||
Nothing -> Left "keyId in Sig header isn't a valid absolute URI"
|
||||
Just uri -> Right uri
|
||||
manager <- getsYesod appHttpManager
|
||||
response <-
|
||||
ExceptT $ first (displayException :: HttpException -> String) <$>
|
||||
(try $
|
||||
httpJSONEither .
|
||||
addRequestHeader "Accept" "application/ld+json; profile=\"https://www.w3.org/ns/activitystreams\"" .
|
||||
setRequestManager manager
|
||||
=<< requestFromURI u
|
||||
)
|
||||
actor <- ExceptT $ bimap displayException responseBody <$> httpGetAP manager u
|
||||
ExceptT . pure $ do
|
||||
actor <- first displayException $ getResponseBody response
|
||||
let uActor = u { uriFragment = "" }
|
||||
if uActor == actorId actor
|
||||
then Right ()
|
||||
|
|
@ -632,6 +628,7 @@ instance YesodBreadcrumbs App where
|
|||
RobotsR -> ("", Nothing)
|
||||
|
||||
InboxR -> ("Inbox", Nothing)
|
||||
OutboxR -> ("Outbox", Nothing)
|
||||
|
||||
HomeR -> ("Home", Nothing)
|
||||
ResendVerifyEmailR -> ( "Resend verification email"
|
||||
|
|
|
|||
|
|
@ -16,6 +16,8 @@
|
|||
module Vervis.Handler.Inbox
|
||||
( getInboxR
|
||||
, postInboxR
|
||||
, getOutboxR
|
||||
, postOutboxR
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -29,29 +31,39 @@ import Control.Monad.STM (atomically)
|
|||
import Control.Monad.Trans.Except (ExceptT (ExceptT), runExceptT)
|
||||
import Crypto.Error (CryptoFailable (..))
|
||||
import Crypto.PubKey.Ed25519 (publicKey, signature, verify)
|
||||
import Data.Aeson (Value (String, Object))
|
||||
import Data.Aeson.Encode.Pretty (encodePretty)
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Encode.Pretty.ToEncoding
|
||||
import Data.Bifunctor (first, second)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import Data.PEM (pemContent)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Text.Lazy.Encoding (decodeUtf8)
|
||||
import Data.Time.Clock (UTCTime, getCurrentTime)
|
||||
import Data.Time.Interval (TimeInterval, toTimeUnit)
|
||||
import Data.Time.Units (Second)
|
||||
import Database.Persist (Entity (..))
|
||||
import Network.HTTP.Client (Manager, HttpException, requestFromURI)
|
||||
import Network.HTTP.Simple (httpJSONEither, getResponseBody, setRequestManager, addRequestHeader)
|
||||
import Network.URI (URI (uriFragment), parseURI)
|
||||
import Network.HTTP.Types.Header (hDate, hHost)
|
||||
import Network.URI
|
||||
import Text.Blaze.Html (Html)
|
||||
import UnliftIO.Exception (try)
|
||||
import Yesod.Core (ContentType, defaultLayout, whamlet)
|
||||
import Yesod.Auth (requireAuth)
|
||||
import Yesod.Core (ContentType, defaultLayout, whamlet, toHtml)
|
||||
import Yesod.Core.Json (requireJsonBody)
|
||||
import Yesod.Core.Handler
|
||||
import Yesod.Form.Fields (Textarea (..), textareaField)
|
||||
import Yesod.Form.Functions (areq, checkMMap, runFormPost, renderDivs)
|
||||
import Yesod.Form.Types (Field, Enctype, FormResult (..))
|
||||
import Yesod.Persist.Core (runDB, get404)
|
||||
|
||||
import qualified Data.ByteString.Char8 as BC (unpack)
|
||||
import qualified Data.CaseInsensitive as CI (mk)
|
||||
import qualified Data.HashMap.Strict as M (lookup)
|
||||
import qualified Data.Text as T (unpack)
|
||||
import qualified Data.HashMap.Strict as M (lookup, insert, adjust, fromList)
|
||||
import qualified Data.Text as T (pack, unpack)
|
||||
import qualified Data.Text.Lazy as TL (toStrict)
|
||||
import qualified Data.Vector as V (length, cons, init)
|
||||
import qualified Network.Wai as W (requestMethod, rawPathInfo, requestHeaders)
|
||||
|
||||
|
|
@ -60,8 +72,11 @@ import Yesod.HttpSignature (verifyRequestSignature)
|
|||
|
||||
import qualified Network.HTTP.Signature as S (Algorithm (..))
|
||||
|
||||
import Vervis.ActivityPub
|
||||
import Vervis.Foundation (App (..), HttpSigVerResult (..), Handler)
|
||||
import Web.ActivityPub
|
||||
|
||||
import Vervis.ActorKey (actorKeySign)
|
||||
import Vervis.Foundation
|
||||
import Vervis.Model
|
||||
import Vervis.Settings (AppSettings (appHttpSigTimeLimit))
|
||||
|
||||
getInboxR :: Handler Html
|
||||
|
|
@ -169,3 +184,105 @@ postInboxR = do
|
|||
_ -> Left "Activity actor isn't a JSON string"
|
||||
_ -> Left "Activity's object isn't a JSON object"
|
||||
return (contentType, o)
|
||||
|
||||
jsonField :: (FromJSON a, ToJSON a) => Field Handler a
|
||||
jsonField = checkMMap fromTextarea toTextarea textareaField
|
||||
where
|
||||
toTextarea = Textarea . TL.toStrict . encodePrettyToLazyText
|
||||
fromTextarea = return . first T.pack . eitherDecodeStrict' . encodeUtf8 . unTextarea
|
||||
|
||||
activityForm :: Form Activity
|
||||
activityForm = renderDivs $ areq jsonField "" $ Just defval
|
||||
where
|
||||
defval = Activity
|
||||
{ activityTo =
|
||||
URI "https:"
|
||||
(Just $ URIAuth "" "forge.angeley.es" "")
|
||||
"/p/aviva"
|
||||
""
|
||||
""
|
||||
, activityJSON = M.fromList
|
||||
[ "@context" .= ("https://www.w3.org/ns/activitystreams" :: Text)
|
||||
, "type" .= ("Create" :: Text)
|
||||
, "object" .= object
|
||||
[ "type" .= ("Note" :: Text)
|
||||
, "content" .= ("Hi! Nice to meet you :)" :: Text)
|
||||
, "to" .= ("https://forge.angeley.es/p/luke" :: Text)
|
||||
]
|
||||
]
|
||||
}
|
||||
|
||||
activityWidget :: Widget -> Enctype -> Widget
|
||||
activityWidget widget enctype =
|
||||
[whamlet|
|
||||
<p>Enter an activity JSON document and click "Submit" to send it.
|
||||
<p>NOTES:
|
||||
<ul>
|
||||
<li>
|
||||
This is a test page for implementing federation in Vervis. The
|
||||
activities just reach a test page, nothing really gets published or
|
||||
changed otherwise.
|
||||
<li>
|
||||
The activity itself just needs to be valid JSON and pass some sanity
|
||||
checks. It isn't verified to look like an ActivityPub activity with
|
||||
ActivityStreams2 properties. So, you can probably post weird things
|
||||
and they will pass.
|
||||
<li>
|
||||
The generated HTTP Signature uses Ed25519, while AFAIK the
|
||||
Fediverse generally uses RSA, specifically RSA-PKCS1.5 (i.e. not
|
||||
PSS) with SHA-256. In other words, send the activities to another
|
||||
Vervis instance, not to Mastodon etc., because the latter won't
|
||||
accept them.
|
||||
<li>
|
||||
Addressing is determined by the "to" field, which has to be a
|
||||
single actor URL. The fields "cc" and "bcc" are ignored at the
|
||||
moment.
|
||||
|
||||
<form method=POST action=@{OutboxR} enctype=#{enctype}>
|
||||
^{widget}
|
||||
<input type=submit>
|
||||
|]
|
||||
|
||||
getOutboxR :: Handler Html
|
||||
getOutboxR = do
|
||||
((_result, widget), enctype) <- runFormPost activityForm
|
||||
defaultLayout $ activityWidget widget enctype
|
||||
|
||||
postOutboxR :: Handler Html
|
||||
postOutboxR = do
|
||||
((result, widget), enctype) <- runFormPost activityForm
|
||||
defaultLayout $ activityWidget widget enctype
|
||||
case result of
|
||||
FormMissing -> setMessage "Field(s) missing"
|
||||
FormFailure _l -> setMessage "Invalid input, see below"
|
||||
FormSuccess (Activity to act) -> do
|
||||
Entity _pid person <- requireAuth
|
||||
let sid = personIdent person
|
||||
sharer <- runDB $ get404 sid
|
||||
let shr = sharerIdent sharer
|
||||
renderUrl <- getUrlRender
|
||||
let actorID = renderUrl $ PersonR shr
|
||||
actID = actorID <> "/fake/1"
|
||||
objID = actorID <> "/fake/2"
|
||||
keyID = actorID <> "#key"
|
||||
updateObj (Object obj) = Object $ M.insert "attributedTo" (String actorID) $ M.insert "id" (String objID) obj
|
||||
updateObj v = v
|
||||
updateAct = M.adjust updateObj "object" . M.insert "actor" (String actorID) . M.insert "id" (String actID)
|
||||
manager <- getsYesod appHttpManager
|
||||
eres <- httpGetAP manager to
|
||||
case eres of
|
||||
Left (APGetErrorHTTP e) -> setMessage $ toHtml $ "Failed to GET the recipient actor: " <> T.pack (displayException e)
|
||||
Left (APGetErrorJSON e) -> setMessage $ toHtml $ "Failed to parse recipient actor JSON: " <> T.pack (displayException e)
|
||||
Left (APGetErrorContentType e) -> setMessage $ toHtml $ "Got unexpected Content-Type for actor JSON: " <> T.pack e
|
||||
Right response -> do
|
||||
let actor = getResponseBody response
|
||||
if actorId actor /= to
|
||||
then setMessage "Fetched actor JSON but its id doesn't match the URL we fetched"
|
||||
else do
|
||||
akey <- liftIO . readTVarIO =<< getsYesod appActorKey
|
||||
let sign b = (KeyId $ encodeUtf8 keyID, actorKeySign akey b)
|
||||
eres' <- httpPostAP manager (actorInbox actor) (hRequestTarget :| [hHost, hDate]) sign (updateAct act)
|
||||
case eres of
|
||||
Left e -> setMessage $ toHtml $ "Failed to POST to recipient's inbox: " <> T.pack (displayException e)
|
||||
Right _ -> setMessage "Activity posted! You can go to the target server's /inbox to see the result."
|
||||
defaultLayout $ activityWidget widget enctype
|
||||
|
|
|
|||
|
|
@ -42,8 +42,9 @@ import Yesod.Auth.Unverified (requireUnverifiedAuth)
|
|||
|
||||
import Text.Email.Local
|
||||
|
||||
import Web.ActivityPub
|
||||
|
||||
--import Vervis.ActivityStreams
|
||||
import Vervis.ActivityPub
|
||||
import Vervis.ActorKey
|
||||
import Vervis.Model.Ident
|
||||
import Vervis.Secure
|
||||
|
|
|
|||
326
src/Web/ActivityPub.hs
Normal file
326
src/Web/ActivityPub.hs
Normal file
|
|
@ -0,0 +1,326 @@
|
|||
{- 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.ActivityPub
|
||||
( -- * Actor
|
||||
--
|
||||
-- ActivityPub actor document including a public key, with a 'FromJSON'
|
||||
-- instance for fetching and a 'ToJSON' instance for publishing.
|
||||
ActorType (..)
|
||||
, Algorithm (..)
|
||||
, PublicKey (..)
|
||||
, Actor (..)
|
||||
|
||||
-- * Activity
|
||||
--
|
||||
-- Very basic activity document which is just general JSON with some
|
||||
-- basic checks. 'FromJSON' instance for receiving POSTs, and 'ToJSON'
|
||||
-- instance for delivering to other servers.
|
||||
, Activity (..)
|
||||
|
||||
-- * Utilities
|
||||
, provideAP
|
||||
, APGetError (..)
|
||||
, httpGetAP
|
||||
, httpPostAP
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Exception (Exception, try)
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Trans.Writer (Writer)
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types (Parser)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.PEM
|
||||
import Data.Semigroup (Endo)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
|
||||
import Network.HTTP.Client
|
||||
import Network.HTTP.Client.Conduit.ActivityPub (httpAPEither)
|
||||
import Network.HTTP.Client.Signature (signRequest)
|
||||
import Network.HTTP.Signature (KeyId, Signature)
|
||||
import Network.HTTP.Simple (JSONException)
|
||||
import Network.HTTP.Types.Header (HeaderName, hContentType)
|
||||
import Network.URI
|
||||
import Yesod.Core.Content (ContentType)
|
||||
import Yesod.Core.Handler (ProvidedRep, provideRepType)
|
||||
|
||||
import qualified Data.HashMap.Strict as M (lookup)
|
||||
import qualified Data.Text as T (unpack)
|
||||
import qualified Data.Vector as V (fromList)
|
||||
|
||||
frg :: Text
|
||||
frg = "https://forgefed.angeley.es/ns#"
|
||||
|
||||
as2context :: Text
|
||||
as2context = "https://www.w3.org/ns/activitystreams"
|
||||
|
||||
actorContext :: Value
|
||||
actorContext = Array $ V.fromList
|
||||
[ String as2context
|
||||
, 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" .= actorContext
|
||||
<> "id" .= renderURI id_
|
||||
<> "type" .= typ
|
||||
<> "preferredUsername" .= username
|
||||
<> "inbox" .= renderURI inbox
|
||||
<> "publicKey" .= pkey
|
||||
|
||||
-- | This may seem trivial, but it exists for a good reason: In the 'FromJSON'
|
||||
-- instance we perform sanity checks. We just don't need to remember the fields
|
||||
-- after checking, so we don't unnecessarily add them as fields. We just keep
|
||||
-- the _to_ field, which tells us who the target actor is (we currently support
|
||||
-- only the _to_ field, and it has to be a single URI, and that URI has to be
|
||||
-- an actor, not a collection). The 'Object' we keep is simply for encoding
|
||||
-- back to JSON. I suppose that's actually silly, we could just keep the actual
|
||||
-- ByteString, but I guess it's okay for now, and it happens to guarantee the
|
||||
-- JSON we POST has no extra whitespace.
|
||||
data Activity = Activity
|
||||
{ activityTo :: URI
|
||||
, activityJSON :: Object
|
||||
}
|
||||
|
||||
instance FromJSON Activity where
|
||||
parseJSON = withObject "Activity" $ \ o -> do
|
||||
c <- o .: "@context"
|
||||
if c == as2context
|
||||
then return ()
|
||||
else fail "@context isn't the AS2 context URI"
|
||||
case M.lookup "id" o of
|
||||
Nothing -> return ()
|
||||
Just _ -> fail "id is provided; let the server set it"
|
||||
case M.lookup "type" o of
|
||||
Nothing -> fail "Activity type missing"
|
||||
Just (String _) -> return ()
|
||||
Just _ -> fail "Activity type isn't a string"
|
||||
case M.lookup "actor" o of
|
||||
Nothing -> return ()
|
||||
Just _ -> fail "actor is provided; let the server set it"
|
||||
mto <- case M.lookup "object" o of
|
||||
Nothing -> return Nothing
|
||||
Just v -> case v of
|
||||
String _ -> return Nothing
|
||||
Object obj -> do
|
||||
case M.lookup "id" obj of
|
||||
Nothing -> return ()
|
||||
Just _ -> fail "object's id is provided; let the server set it"
|
||||
case M.lookup "type" obj of
|
||||
Nothing -> fail "Activity object type missing"
|
||||
Just (String _) -> return ()
|
||||
Just _ -> fail "Activity object type isn't a string"
|
||||
case M.lookup "actor" o <|> M.lookup "attributedTo" o of
|
||||
Nothing -> return ()
|
||||
Just _ -> fail "attribution is provided; let the server set it"
|
||||
obj .:? "to"
|
||||
_ -> fail "Activity object isn't JSON string or object"
|
||||
mto2 <- o .:? "to"
|
||||
to <- case mto <|> mto2 of
|
||||
Nothing -> fail "to not provided"
|
||||
Just t -> parseURI' t
|
||||
return $ Activity to o
|
||||
|
||||
instance ToJSON Activity where
|
||||
toJSON = error "toJSON Activity"
|
||||
toEncoding = toEncoding . activityJSON
|
||||
|
||||
typeActivityStreams2 :: ContentType
|
||||
typeActivityStreams2 = "application/activity+json"
|
||||
|
||||
typeActivityStreams2LD :: ContentType
|
||||
typeActivityStreams2LD =
|
||||
"application/ld+json; profile=\"https://www.w3.org/ns/activitystreams\""
|
||||
|
||||
provideAP :: (Monad m, ToJSON a) => a -> Writer (Endo [ProvidedRep m]) ()
|
||||
provideAP v = do
|
||||
let enc = toEncoding v
|
||||
-- provideRepType typeActivityStreams2 $ return enc
|
||||
provideRepType typeActivityStreams2LD $ return enc
|
||||
|
||||
data APGetError
|
||||
= APGetErrorHTTP HttpException
|
||||
| APGetErrorJSON JSONException
|
||||
| APGetErrorContentType String
|
||||
deriving Show
|
||||
|
||||
instance Exception APGetError
|
||||
|
||||
-- | Perform an HTTP GET request to fetch an ActivityPub object.
|
||||
--
|
||||
-- * Verify the URI scheme is _https:_ and authority part is present
|
||||
-- * Set _Accept_ request header
|
||||
-- * Perform the GET request
|
||||
-- * Verify the _Content-Type_ response header
|
||||
-- * Parse the JSON response body
|
||||
httpGetAP
|
||||
:: (MonadIO m, FromJSON a)
|
||||
=> Manager
|
||||
-> URI
|
||||
-> m (Either APGetError (Response a))
|
||||
httpGetAP manager uri =
|
||||
if uriScheme uri /= "https:"
|
||||
then return $ Left $ APGetErrorHTTP $ InvalidUrlException (show uri) "Scheme isn't https"
|
||||
else liftIO $ mkResult <$> try (httpAPEither manager =<< requestFromURI uri)
|
||||
where
|
||||
lookup' x = map snd . filter ((== x) . fst)
|
||||
mkResult (Left e) = Left $ APGetErrorHTTP e
|
||||
mkResult (Right r) =
|
||||
case lookup' hContentType $ responseHeaders r of
|
||||
[] -> Left $ APGetErrorContentType "No Content-Type"
|
||||
[b] -> if b == typeActivityStreams2LD || b == typeActivityStreams2
|
||||
then case responseBody r of
|
||||
Left e -> Left $ APGetErrorJSON e
|
||||
Right v -> Right $ v <$ r
|
||||
else Left $ APGetErrorContentType "Non-AP Content-Type"
|
||||
_ -> Left $ APGetErrorContentType "Multiple Content-Type"
|
||||
|
||||
-- Set method to POST, Set Content-Type, make HTTP signature, set response to throw on non-2xx
|
||||
-- status
|
||||
|
||||
-- | Perform an HTTP POST request to submit an ActivityPub object.
|
||||
--
|
||||
-- * Verify the URI scheme is _https:_ and authority part is present
|
||||
-- * Set _Content-Type_ request header
|
||||
-- * Compute HTTP signature and add _Signature_ request header
|
||||
-- * Perform the POST request
|
||||
-- * Verify the response status is 2xx
|
||||
httpPostAP
|
||||
:: (MonadIO m, ToJSON a)
|
||||
=> Manager
|
||||
-> URI
|
||||
-> NonEmpty HeaderName
|
||||
-> (ByteString -> (KeyId, Signature))
|
||||
-> a
|
||||
-> m (Either HttpException (Response ()))
|
||||
httpPostAP manager uri headers sign value =
|
||||
if uriScheme uri /= "https:"
|
||||
then return $ Left $ InvalidUrlException (show uri) "Scheme isn't https"
|
||||
else liftIO $ try $ do
|
||||
req <- requestFromURI uri
|
||||
let req' =
|
||||
setRequestCheckStatus $
|
||||
consHeader hContentType typeActivityStreams2LD $
|
||||
req { method = "POST"
|
||||
, requestBody = RequestBodyLBS $ encode value
|
||||
}
|
||||
sign' b =
|
||||
let (k, s) = sign b
|
||||
in (Nothing, k, s)
|
||||
req'' <- signRequest headers sign' Nothing req'
|
||||
httpNoBody req' manager
|
||||
where
|
||||
consHeader n b r = r { requestHeaders = (n, b) : requestHeaders r }
|
||||
|
|
@ -18,6 +18,7 @@ packages:
|
|||
- lib/hit-graph
|
||||
- lib/hit-harder
|
||||
- lib/hit-network
|
||||
- lib/http-client-signature
|
||||
- lib/http-signature
|
||||
- lib/persistent-migration
|
||||
- lib/persistent-email-address
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@ DEPS='hit-graph
|
|||
hit-network
|
||||
darcs-lights
|
||||
darcs-rev
|
||||
http-client-signature
|
||||
http-signature
|
||||
ssh
|
||||
persistent-migration
|
||||
|
|
|
|||
|
|
@ -41,6 +41,7 @@ library
|
|||
exposed-modules: Control.Applicative.Local
|
||||
Control.Concurrent.Local
|
||||
Darcs.Local.Repository
|
||||
Data.Aeson.Encode.Pretty.ToEncoding
|
||||
Data.Attoparsec.ByteString.Local
|
||||
Data.Binary.Local
|
||||
Data.ByteString.Char8.Local
|
||||
|
|
@ -83,12 +84,14 @@ library
|
|||
Diagrams.IntransitiveDAG
|
||||
Formatting.CaseInsensitive
|
||||
Language.Haskell.TH.Quote.Local
|
||||
Network.HTTP.Client.Conduit.ActivityPub
|
||||
Network.SSH.Local
|
||||
Text.Blaze.Local
|
||||
Text.Display
|
||||
Text.Email.Local
|
||||
Text.FilePath.Local
|
||||
Text.Jasmine.Local
|
||||
Web.ActivityPub
|
||||
Web.PathPieces.Local
|
||||
Yesod.Auth.Unverified
|
||||
Yesod.Auth.Unverified.Creds
|
||||
|
|
@ -96,7 +99,6 @@ library
|
|||
Yesod.Paginate.Local
|
||||
Yesod.SessionEntity
|
||||
|
||||
Vervis.ActivityPub
|
||||
Vervis.ActivityStreams
|
||||
Vervis.ActorKey
|
||||
Vervis.Application
|
||||
|
|
@ -228,6 +230,8 @@ library
|
|||
-- for defining colors for use with diagrams
|
||||
, colour
|
||||
, conduit
|
||||
-- For httpAPEither
|
||||
, conduit-extra
|
||||
, containers
|
||||
, cryptonite
|
||||
-- for Storage.Hashed because hashed-storage seems
|
||||
|
|
@ -260,6 +264,7 @@ library
|
|||
, hashable
|
||||
-- for source file highlighting
|
||||
, highlighter2
|
||||
, http-client-signature
|
||||
, http-signature
|
||||
, git
|
||||
, hit-graph
|
||||
|
|
@ -318,6 +323,8 @@ library
|
|||
, transformers
|
||||
-- probably should be replaced with lenses once I learn
|
||||
, tuple
|
||||
-- For httpAPEither
|
||||
, unliftio-core
|
||||
, unliftio
|
||||
, unordered-containers
|
||||
, vector
|
||||
|
|
|
|||
Loading…
Reference in a new issue