bluesky-tools 0.2.2.0 → 0.4.0.0

raw patch · 4 files changed

+84/−18 lines, 4 filesdep +containersdep +network-uriPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, network-uri

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−2
• bluesky-tools.cabal +3/−1
• src/Bluesky/Did.hs +54/−6
• src/Bluesky/Handle.hs +18/−9

@@ -1,9 +1,16 @@ # Revision history for bluesky-tools +## 0.4.0.0 -- 2024-01-06++* Stop exporting Document constructor so I can continue to change it.+* getPds retrieves the PDS URI from a DID document.+* Add Handle.verifyHandle.+* Tweak Handle.resolveVerify so that failing to fetch DID document is a verification failure.+ ## 0.2.2.0 -- 2024-01-05 -* Fix build error-* Export unintentionally-hidden BothFailed+* Fix build error.+* Export unintentionally-hidden BothFailed.  ## 0.2.0.0 -- 2024-01-05 

@@ -1,7 +1,7 @@ cabal-version:      3.4  name:               bluesky-tools-version:            0.2.2.0+version:            0.4.0.0 synopsis:           Tools for interacting with Bluesky / AT Protocol description:   bluesky-tools provides tools that I've found useful while trying to integrate@@ -46,10 +46,12 @@     aeson ^>=2.1,     async ^>=2.2,     base ^>=4.18,+    containers ^>=0.6,     dns ^>=4.2,     http-api-data ^>=0.6,     http-client ^>=0.7,     http-types ^>=0.12,+    network-uri ^>=2.6,     text ^>=2.0,     transformers ^>=0.6, 

@@ -1,10 +1,15 @@ module Bluesky.Did   ( Did(Did), rawDid-  , Document(Document, alsoKnownAs)+  , Document(alsoKnownAs), getPds   , getDocument   ) where  import qualified Data.Aeson as Aeson+import Data.Aeson ((.:))+import qualified Data.Aeson.Types as Aeson+import qualified Data.Map as Map+import Data.Maybe+import Data.Monoid (First(First, getFirst)) import qualified Data.Text as Text import Data.Text (Text) import GHC.Generics@@ -12,8 +17,10 @@  import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Types.Status as HTTP+import qualified Network.URI as URI  -- | https://atproto.com/specs/did+-- -- A DID is a Decentralized Identifier. They're codified by various W3C -- standards. This type only aims to capture how they are used in atproto. --@@ -36,14 +43,55 @@   | "did:plc:" `Text.isPrefixOf` rawDid = Just Plc   | otherwise = Nothing --- | Currently this is only used for ensuring a handle that has been resolved to--- a DID is referenced by the DID document (so it is the correct handle for this--- DID). The other fields are ignored.+data Service = Service+  { serviceId :: Text+  , serviceType :: Text+  , serviceEndpoint :: URI.URI+  } deriving stock (Eq, Ord, Show, Generic)++instance Aeson.FromJSON Service where+  parseJSON = Aeson.withObject "Service" $ \o -> do+    serviceId <- o .: "id"+    serviceType <- o .: "type"+    serviceEndpointString <- o .: "serviceEndpoint" -- [sic]+    serviceEndpoint <-+      maybe+        (fail $ "Couldn't parse serviceEndpoint URI: " <> show serviceEndpointString)+        pure+        $ URI.parseURI serviceEndpointString+    pure Service{ serviceId, serviceType, serviceEndpoint }++-- | Fields that the library currently doesn't understand are ignored. data Document = Document-  { id :: Did+  { documentId :: Did   , alsoKnownAs :: [Text]+  , service :: [Service]   } deriving stock (Eq, Ord, Show, Generic)-    deriving anyclass (Aeson.FromJSON)++getPds :: Document -> Maybe URI.URI+getPds Document{ service } =+  getFirst $ foldMap (First . get) service+  where+    get Service{ serviceId, serviceType, serviceEndpoint }+      | "#atproto_pds" `Text.isSuffixOf` serviceId+        && serviceType == "AtprotoPersonalDataServer"+        = Just serviceEndpoint+      | otherwise = Nothing++genericParseJSONMapFields+  :: (Generic a, Aeson.GFromJSON Aeson.Zero (Rep a))+  => [(String, String)] -> Aeson.Value -> Aeson.Parser a+genericParseJSONMapFields fields =+  Aeson.genericParseJSON+    Aeson.defaultOptions{ Aeson.fieldLabelModifier = mapFields }+  where+    mapFields field = fromMaybe field (Map.lookup field fieldsMap)+    fieldsMap = Map.fromList fields++instance Aeson.FromJSON Document where+  parseJSON =+    genericParseJSONMapFields+      [("documentId", "id")]  -- | This is currently only implemented for did:plc: DIDs. getDocument :: HasCallStack => HTTP.Manager -> Did -> IO (Maybe Document)

@@ -1,12 +1,12 @@ module Bluesky.Handle   ( Handle, rawHandle, makeHandle, HandleError(..), validTld   , resolveViaDns, resolveViaHttp, resolveViaBoth, BothFailed(..)-  , resolveVerify+  , verifyHandle, resolveVerify   ) where  import qualified Control.Concurrent.Async as Async import qualified Control.Exception as Except-import Control.Monad+import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe import qualified Data.Aeson as Aeson import Data.Aeson ((.:))@@ -155,12 +155,21 @@     fromE (Right (Just dnsException, Just httpException)) =       Except.throwIO BothFailed{ dnsException, httpException } --- | Also fetches the DID document and checks that the handle is listed there.--- Raises an error if not.+-- | 'Just True' if this 'Handle' appears in the DID 'Document' for the 'Did'.+-- 'Just False' if the document is available and doesn't affirm the handle.+-- 'Nothing' if the document can't be fetched.+verifyHandle :: HTTP.Manager -> Handle -> Did -> IO (Maybe Bool)+verifyHandle httpManager (Handle rawHandle) did = runMaybeT $ do+  doc <- MaybeT $ getDocument httpManager did+  pure $ ("at://" <> rawHandle) `elem` alsoKnownAs doc++-- | Combines 'resolveViaBoth' and 'verifyHandle'. Raises an error if+-- verification fails. resolveVerify :: HasCallStack => HTTP.Manager -> Handle -> IO (Maybe Did)-resolveVerify httpManager handle@(Handle rawHandle) = runMaybeT $ do+resolveVerify httpManager handle = runMaybeT $ do   did <- MaybeT $ resolveViaBoth httpManager handle-  Document{ alsoKnownAs } <- MaybeT $ getDocument httpManager did-  unless (("at://" <> rawHandle) `elem` alsoKnownAs) $-    error "Handle isn't in alsoKnownAs for its DID document"-  pure did+  verified <- lift $ verifyHandle httpManager handle did+  case verified of+    Nothing -> error "Can't get DID document to verify handle"+    Just False -> error "Handle failed verification: not in DID document"+    Just True -> pure did