diff --git a/src/Data/Aeson/Local.hs b/src/Data/Aeson/Local.hs new file mode 100644 index 0000000..8e2fdc3 --- /dev/null +++ b/src/Data/Aeson/Local.hs @@ -0,0 +1,51 @@ +{- This file is part of Vervis. + - + - Written in 2019 by fr33domlover . + - + - ♡ 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 + - . + -} + +module Data.Aeson.Local + ( frg + , parseHttpsURI + , renderURI + , (.=?) + ) +where + +import Prelude + +import Data.Aeson +import Data.Aeson.Types (Parser) +import Data.Text (Text) +import Network.URI + +import qualified Data.Text as T (unpack) + +frg :: Text +frg = "https://forgefed.angeley.es/ns#" + +parseHttpsURI :: Text -> Parser URI +parseHttpsURI 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 "" + +infixr 8 .=? +(.=?) :: ToJSON v => Text -> Maybe v -> Series +k .=? Nothing = mempty +k .=? (Just v) = k .= v diff --git a/src/Vervis/ActorKey.hs b/src/Vervis/ActorKey.hs index 533e784..c1ed729 100644 --- a/src/Vervis/ActorKey.hs +++ b/src/Vervis/ActorKey.hs @@ -20,7 +20,7 @@ module Vervis.ActorKey , loadActorKey , actorKeyPublicBin , actorKeySign - , actorKeyVerify + -- , actorKeyVerify ) where diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 642db1d..3e811a6 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -66,8 +66,7 @@ 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#" +import Data.Aeson.Local as2context :: Text as2context = "https://www.w3.org/ns/activitystreams" @@ -78,18 +77,6 @@ actorContext = Array $ V.fromList , 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 @@ -130,8 +117,8 @@ data PublicKey = PublicKey instance FromJSON PublicKey where parseJSON = withObject "PublicKey" $ \ o -> PublicKey - <$> (parseURI' =<< o .: "id") - <*> (parseURI' =<< o .: "owner") + <$> (parseHttpsURI =<< o .: "id") + <*> (parseHttpsURI =<< o .: "owner") <*> (parsePEM =<< o .: "publicKeyPem") <*> o .:? (frg <> "algorithm") where @@ -164,10 +151,10 @@ data Actor = Actor instance FromJSON Actor where parseJSON = withObject "Actor" $ \ o -> Actor - <$> (parseURI' =<< o .: "id") + <$> (parseHttpsURI =<< o .: "id") <*> o .: "type" <*> o .: "preferredUsername" - <*> (parseURI' =<< o .: "inbox") + <*> (parseHttpsURI =<< o .: "inbox") <*> o .: "publicKey" instance ToJSON Actor where @@ -231,7 +218,7 @@ instance FromJSON Activity where mto2 <- o .:? "to" to <- case mto <|> mto2 of Nothing -> fail "to not provided" - Just t -> parseURI' t + Just t -> parseHttpsURI t return $ Activity to o instance ToJSON Activity where diff --git a/vervis.cabal b/vervis.cabal index 8ae18bb..16f9ba7 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -42,6 +42,7 @@ library Control.Concurrent.Local Darcs.Local.Repository Data.Aeson.Encode.Pretty.ToEncoding + Data.Aeson.Local Data.Attoparsec.ByteString.Local Data.Binary.Local Data.ByteString.Char8.Local