module Bluesky.Did
  ( Did, rawDid, makeDid, DidError(..)
  , Document(alsoKnownAs), getPds
  , getDocument
  ) where

import qualified Data.Aeson as Aeson
import Data.Aeson ((.:))
import qualified Data.Aeson.Types as Aeson
import qualified Data.Char as Char
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
import GHC.Stack

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.
newtype Did = Did { Did -> Text
rawDid :: Text }
  deriving stock (Did -> Did -> Bool
(Did -> Did -> Bool) -> (Did -> Did -> Bool) -> Eq Did
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Did -> Did -> Bool
== :: Did -> Did -> Bool
$c/= :: Did -> Did -> Bool
/= :: Did -> Did -> Bool
Eq, Eq Did
Eq Did =>
(Did -> Did -> Ordering)
-> (Did -> Did -> Bool)
-> (Did -> Did -> Bool)
-> (Did -> Did -> Bool)
-> (Did -> Did -> Bool)
-> (Did -> Did -> Did)
-> (Did -> Did -> Did)
-> Ord Did
Did -> Did -> Bool
Did -> Did -> Ordering
Did -> Did -> Did
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Did -> Did -> Ordering
compare :: Did -> Did -> Ordering
$c< :: Did -> Did -> Bool
< :: Did -> Did -> Bool
$c<= :: Did -> Did -> Bool
<= :: Did -> Did -> Bool
$c> :: Did -> Did -> Bool
> :: Did -> Did -> Bool
$c>= :: Did -> Did -> Bool
>= :: Did -> Did -> Bool
$cmax :: Did -> Did -> Did
max :: Did -> Did -> Did
$cmin :: Did -> Did -> Did
min :: Did -> Did -> Did
Ord, Int -> Did -> ShowS
[Did] -> ShowS
Did -> String
(Int -> Did -> ShowS)
-> (Did -> String) -> ([Did] -> ShowS) -> Show Did
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Did -> ShowS
showsPrec :: Int -> Did -> ShowS
$cshow :: Did -> String
show :: Did -> String
$cshowList :: [Did] -> ShowS
showList :: [Did] -> ShowS
Show)
  deriving newtype ([Did] -> Value
[Did] -> Encoding
Did -> Bool
Did -> Value
Did -> Encoding
(Did -> Value)
-> (Did -> Encoding)
-> ([Did] -> Value)
-> ([Did] -> Encoding)
-> (Did -> Bool)
-> ToJSON Did
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Did -> Value
toJSON :: Did -> Value
$ctoEncoding :: Did -> Encoding
toEncoding :: Did -> Encoding
$ctoJSONList :: [Did] -> Value
toJSONList :: [Did] -> Value
$ctoEncodingList :: [Did] -> Encoding
toEncodingList :: [Did] -> Encoding
$comitField :: Did -> Bool
omitField :: Did -> Bool
Aeson.ToJSON)

data DidError
  = NoDidPrefix
  | NoMethodSeparator
    -- ^ after "did:", there must be another colon to delimit method from
    -- identifier
  | BadMethod
    -- ^ method must match the regex @[a-z]+@; this does not check if the method
    -- is supported by atproto
  | BadIdentifierCharacters
    -- ^ identifier section must match @[a-zA-Z0-9._:%-]@
    -- (nb. that general DID URIs may also have query and fragment components,
    -- i.e. @?@ and @#@ characters, but atproto DID identifiers may not)
  | EndsWithColon
  | BadPercentEncoding
    -- ^ the spec says implementations don't need to validate percent encoding,
    -- but we validate that every % is followed by two hex digits
  deriving stock (Int -> DidError -> ShowS
[DidError] -> ShowS
DidError -> String
(Int -> DidError -> ShowS)
-> (DidError -> String) -> ([DidError] -> ShowS) -> Show DidError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DidError -> ShowS
showsPrec :: Int -> DidError -> ShowS
$cshow :: DidError -> String
show :: DidError -> String
$cshowList :: [DidError] -> ShowS
showList :: [DidError] -> ShowS
Show, DidError -> DidError -> Bool
(DidError -> DidError -> Bool)
-> (DidError -> DidError -> Bool) -> Eq DidError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DidError -> DidError -> Bool
== :: DidError -> DidError -> Bool
$c/= :: DidError -> DidError -> Bool
/= :: DidError -> DidError -> Bool
Eq, Eq DidError
Eq DidError =>
(DidError -> DidError -> Ordering)
-> (DidError -> DidError -> Bool)
-> (DidError -> DidError -> Bool)
-> (DidError -> DidError -> Bool)
-> (DidError -> DidError -> Bool)
-> (DidError -> DidError -> DidError)
-> (DidError -> DidError -> DidError)
-> Ord DidError
DidError -> DidError -> Bool
DidError -> DidError -> Ordering
DidError -> DidError -> DidError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DidError -> DidError -> Ordering
compare :: DidError -> DidError -> Ordering
$c< :: DidError -> DidError -> Bool
< :: DidError -> DidError -> Bool
$c<= :: DidError -> DidError -> Bool
<= :: DidError -> DidError -> Bool
$c> :: DidError -> DidError -> Bool
> :: DidError -> DidError -> Bool
$c>= :: DidError -> DidError -> Bool
>= :: DidError -> DidError -> Bool
$cmax :: DidError -> DidError -> DidError
max :: DidError -> DidError -> DidError
$cmin :: DidError -> DidError -> DidError
min :: DidError -> DidError -> DidError
Ord)

makeDid :: Text -> Either DidError Did
makeDid :: Text -> Either DidError Did
makeDid Text
raw
  | Bool -> Bool
not (Text
"did:" Text -> Text -> Bool
`Text.isPrefixOf` Text
raw) = DidError -> Either DidError Did
forall a b. a -> Either a b
Left DidError
NoDidPrefix
  | Text -> Bool
Text.null Text
method
    Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
Text.any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isMethodChar) Text
method = DidError -> Either DidError Did
forall a b. a -> Either a b
Left DidError
BadMethod
  | (Char -> Bool) -> Text -> Bool
Text.any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isIdentifierChar) Text
colonBody = DidError -> Either DidError Did
forall a b. a -> Either a b
Left DidError
BadIdentifierCharacters
  | Int -> Text -> Text
Text.takeEnd Int
1 Text
raw Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
":" = DidError -> Either DidError Did
forall a b. a -> Either a b
Left DidError
EndsWithColon
  | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
Char.isHexDigit) [Text]
percentEncodes = DidError -> Either DidError Did
forall a b. a -> Either a b
Left DidError
BadPercentEncoding
  | Bool
otherwise = Did -> Either DidError Did
forall a b. b -> Either a b
Right (Text -> Did
Did Text
raw)
  where
    afterPrefix :: Text
afterPrefix = Int -> Text -> Text
Text.drop Int
4 Text
raw
    (Text
method, Text
colonBody) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
Text.breakOn Text
":" Text
afterPrefix
    isMethodChar :: Char -> Bool
isMethodChar Char
c = Char -> Bool
Char.isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
Char.isLower Char
c
    isIdentifierChar :: Char -> Bool
isIdentifierChar Char
c =
      Char -> Bool
Char.isAscii Char
c
      Bool -> Bool -> Bool
&& (Char -> Bool
Char.isAlphaNum Char
c Bool -> Bool -> Bool
|| Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c (String
"._:%-" :: [Char]))
    percentEncodes :: [Text]
percentEncodes = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
Text.take Int
2) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"%" Text
colonBody

instance Aeson.FromJSON Did where
  parseJSON :: Value -> Parser Did
parseJSON = String -> (Text -> Parser Did) -> Value -> Parser Did
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Bluesky.Did.Did" ((Text -> Parser Did) -> Value -> Parser Did)
-> (Text -> Parser Did) -> Value -> Parser Did
forall a b. (a -> b) -> a -> b
$ (DidError -> Parser Did)
-> (Did -> Parser Did) -> Either DidError Did -> Parser Did
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Did
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Did)
-> (DidError -> String) -> DidError -> Parser Did
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DidError -> String
forall a. Show a => a -> String
show) Did -> Parser Did
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DidError Did -> Parser Did)
-> (Text -> Either DidError Did) -> Text -> Parser Did
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either DidError Did
makeDid

-- | The DID methods supported by atproto. Note that DIDs are used outside of
-- atproto and there are many more methods in those contexts, but we don't
-- support them here.
data Method
  = Web -- ^ https://w3c-ccg.github.io/did-method-web/
  | Plc -- ^ https://github.com/did-method-plc/did-method-plc
  deriving stock (Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
/= :: Method -> Method -> Bool
Eq, Eq Method
Eq Method =>
(Method -> Method -> Ordering)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Method)
-> (Method -> Method -> Method)
-> Ord Method
Method -> Method -> Bool
Method -> Method -> Ordering
Method -> Method -> Method
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Method -> Method -> Ordering
compare :: Method -> Method -> Ordering
$c< :: Method -> Method -> Bool
< :: Method -> Method -> Bool
$c<= :: Method -> Method -> Bool
<= :: Method -> Method -> Bool
$c> :: Method -> Method -> Bool
> :: Method -> Method -> Bool
$c>= :: Method -> Method -> Bool
>= :: Method -> Method -> Bool
$cmax :: Method -> Method -> Method
max :: Method -> Method -> Method
$cmin :: Method -> Method -> Method
min :: Method -> Method -> Method
Ord, Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Method -> ShowS
showsPrec :: Int -> Method -> ShowS
$cshow :: Method -> String
show :: Method -> String
$cshowList :: [Method] -> ShowS
showList :: [Method] -> ShowS
Show)

getMethod :: Did -> Maybe Method
getMethod :: Did -> Maybe Method
getMethod Did{ Text
rawDid :: Did -> Text
rawDid :: Text
rawDid }
  | Text
"did:web:" Text -> Text -> Bool
`Text.isPrefixOf` Text
rawDid = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
Web
  | Text
"did:plc:" Text -> Text -> Bool
`Text.isPrefixOf` Text
rawDid = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
Plc
  | Bool
otherwise = Maybe Method
forall a. Maybe a
Nothing

data Service = Service
  { Service -> Text
serviceId :: Text
  , Service -> Text
serviceType :: Text
  , Service -> URI
serviceEndpoint :: URI.URI
  } deriving stock (Service -> Service -> Bool
(Service -> Service -> Bool)
-> (Service -> Service -> Bool) -> Eq Service
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Service -> Service -> Bool
== :: Service -> Service -> Bool
$c/= :: Service -> Service -> Bool
/= :: Service -> Service -> Bool
Eq, Eq Service
Eq Service =>
(Service -> Service -> Ordering)
-> (Service -> Service -> Bool)
-> (Service -> Service -> Bool)
-> (Service -> Service -> Bool)
-> (Service -> Service -> Bool)
-> (Service -> Service -> Service)
-> (Service -> Service -> Service)
-> Ord Service
Service -> Service -> Bool
Service -> Service -> Ordering
Service -> Service -> Service
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Service -> Service -> Ordering
compare :: Service -> Service -> Ordering
$c< :: Service -> Service -> Bool
< :: Service -> Service -> Bool
$c<= :: Service -> Service -> Bool
<= :: Service -> Service -> Bool
$c> :: Service -> Service -> Bool
> :: Service -> Service -> Bool
$c>= :: Service -> Service -> Bool
>= :: Service -> Service -> Bool
$cmax :: Service -> Service -> Service
max :: Service -> Service -> Service
$cmin :: Service -> Service -> Service
min :: Service -> Service -> Service
Ord, Int -> Service -> ShowS
[Service] -> ShowS
Service -> String
(Int -> Service -> ShowS)
-> (Service -> String) -> ([Service] -> ShowS) -> Show Service
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Service -> ShowS
showsPrec :: Int -> Service -> ShowS
$cshow :: Service -> String
show :: Service -> String
$cshowList :: [Service] -> ShowS
showList :: [Service] -> ShowS
Show, (forall x. Service -> Rep Service x)
-> (forall x. Rep Service x -> Service) -> Generic Service
forall x. Rep Service x -> Service
forall x. Service -> Rep Service x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Service -> Rep Service x
from :: forall x. Service -> Rep Service x
$cto :: forall x. Rep Service x -> Service
to :: forall x. Rep Service x -> Service
Generic)

instance Aeson.FromJSON Service where
  parseJSON :: Value -> Parser Service
parseJSON = String -> (Object -> Parser Service) -> Value -> Parser Service
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Bluesky.Did.Service" ((Object -> Parser Service) -> Value -> Parser Service)
-> (Object -> Parser Service) -> Value -> Parser Service
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
serviceId <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
serviceType <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    String
serviceEndpointString <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"serviceEndpoint" -- [sic]
    URI
serviceEndpoint <-
      Parser URI -> (URI -> Parser URI) -> Maybe URI -> Parser URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (String -> Parser URI
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser URI) -> String -> Parser URI
forall a b. (a -> b) -> a -> b
$ String
"Couldn't parse serviceEndpoint URI: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
serviceEndpointString)
        URI -> Parser URI
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Maybe URI -> Parser URI) -> Maybe URI -> Parser URI
forall a b. (a -> b) -> a -> b
$ String -> Maybe URI
URI.parseURI String
serviceEndpointString
    Service -> Parser Service
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Service{ Text
serviceId :: Text
serviceId :: Text
serviceId, Text
serviceType :: Text
serviceType :: Text
serviceType, URI
serviceEndpoint :: URI
serviceEndpoint :: URI
serviceEndpoint }

-- | Fields that the library currently doesn't understand are ignored.
data Document = Document
  { Document -> Did
documentId :: Did
  , Document -> [Text]
alsoKnownAs :: [Text]
  , Document -> [Service]
service :: [Service]
  } deriving stock (Document -> Document -> Bool
(Document -> Document -> Bool)
-> (Document -> Document -> Bool) -> Eq Document
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Document -> Document -> Bool
== :: Document -> Document -> Bool
$c/= :: Document -> Document -> Bool
/= :: Document -> Document -> Bool
Eq, Eq Document
Eq Document =>
(Document -> Document -> Ordering)
-> (Document -> Document -> Bool)
-> (Document -> Document -> Bool)
-> (Document -> Document -> Bool)
-> (Document -> Document -> Bool)
-> (Document -> Document -> Document)
-> (Document -> Document -> Document)
-> Ord Document
Document -> Document -> Bool
Document -> Document -> Ordering
Document -> Document -> Document
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Document -> Document -> Ordering
compare :: Document -> Document -> Ordering
$c< :: Document -> Document -> Bool
< :: Document -> Document -> Bool
$c<= :: Document -> Document -> Bool
<= :: Document -> Document -> Bool
$c> :: Document -> Document -> Bool
> :: Document -> Document -> Bool
$c>= :: Document -> Document -> Bool
>= :: Document -> Document -> Bool
$cmax :: Document -> Document -> Document
max :: Document -> Document -> Document
$cmin :: Document -> Document -> Document
min :: Document -> Document -> Document
Ord, Int -> Document -> ShowS
[Document] -> ShowS
Document -> String
(Int -> Document -> ShowS)
-> (Document -> String) -> ([Document] -> ShowS) -> Show Document
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Document -> ShowS
showsPrec :: Int -> Document -> ShowS
$cshow :: Document -> String
show :: Document -> String
$cshowList :: [Document] -> ShowS
showList :: [Document] -> ShowS
Show, (forall x. Document -> Rep Document x)
-> (forall x. Rep Document x -> Document) -> Generic Document
forall x. Rep Document x -> Document
forall x. Document -> Rep Document x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Document -> Rep Document x
from :: forall x. Document -> Rep Document x
$cto :: forall x. Rep Document x -> Document
to :: forall x. Rep Document x -> Document
Generic)

getPds :: Document -> Maybe URI.URI
getPds :: Document -> Maybe URI
getPds Document{ [Service]
service :: Document -> [Service]
service :: [Service]
service } =
  First URI -> Maybe URI
forall a. First a -> Maybe a
getFirst (First URI -> Maybe URI) -> First URI -> Maybe URI
forall a b. (a -> b) -> a -> b
$ (Service -> First URI) -> [Service] -> First URI
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe URI -> First URI
forall a. Maybe a -> First a
First (Maybe URI -> First URI)
-> (Service -> Maybe URI) -> Service -> First URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Service -> Maybe URI
get) [Service]
service
  where
    get :: Service -> Maybe URI
get Service{ Text
serviceId :: Service -> Text
serviceId :: Text
serviceId, Text
serviceType :: Service -> Text
serviceType :: Text
serviceType, URI
serviceEndpoint :: Service -> URI
serviceEndpoint :: URI
serviceEndpoint }
      | Text
"#atproto_pds" Text -> Text -> Bool
`Text.isSuffixOf` Text
serviceId
        Bool -> Bool -> Bool
&& Text
serviceType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"AtprotoPersonalDataServer"
        = URI -> Maybe URI
forall a. a -> Maybe a
Just URI
serviceEndpoint
      | Bool
otherwise = Maybe URI
forall a. Maybe a
Nothing

genericParseJSONMapFields
  :: (Generic a, Aeson.GFromJSON Aeson.Zero (Rep a))
  => [(String, String)] -> Aeson.Value -> Aeson.Parser a
genericParseJSONMapFields :: forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
[(String, String)] -> Value -> Parser a
genericParseJSONMapFields [(String, String)]
fields =
  Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON
    Options
Aeson.defaultOptions{ Aeson.fieldLabelModifier = mapFields }
  where
    mapFields :: ShowS
mapFields String
field = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
field (String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
field Map String String
fieldsMap)
    fieldsMap :: Map String String
fieldsMap = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, String)]
fields

instance Aeson.FromJSON Document where
  parseJSON :: Value -> Parser Document
parseJSON =
    [(String, String)] -> Value -> Parser Document
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
[(String, String)] -> Value -> Parser a
genericParseJSONMapFields
      [(String
"documentId", String
"id")]

-- | This is currently only implemented for did:plc: DIDs.
getDocument :: HasCallStack => HTTP.Manager -> Did -> IO (Maybe Document)
getDocument :: HasCallStack => Manager -> Did -> IO (Maybe Document)
getDocument Manager
httpManager did :: Did
did@(Did Text
rawDid) =
  case Did -> Maybe Method
getMethod Did
did of
    Maybe Method
Nothing -> String -> IO (Maybe Document)
forall a. HasCallStack => String -> a
error String
"Unknown DID method"
    Just Method
Web -> String -> IO (Maybe Document)
forall a. HasCallStack => String -> a
error String
"Support for did:web: is not yet implemented"
    Just Method
Plc -> do
      Request
req <-
        String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
HTTP.parseRequest
          (String
"https://plc.directory/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
rawDid)
      Response ByteString
resp <- Request -> Manager -> IO (Response ByteString)
HTTP.httpLbs Request
req Manager
httpManager
      case Status -> Int
HTTP.statusCode (Response ByteString -> Status
forall body. Response body -> Status
HTTP.responseStatus Response ByteString
resp) of
        Int
404 -> Maybe Document -> IO (Maybe Document)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Document
forall a. Maybe a
Nothing
        Int
200 -> (String -> IO (Maybe Document))
-> (Document -> IO (Maybe Document))
-> Either String Document
-> IO (Maybe Document)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO (Maybe Document)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Maybe Document -> IO (Maybe Document)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Document -> IO (Maybe Document))
-> (Document -> Maybe Document) -> Document -> IO (Maybe Document)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Maybe Document
forall a. a -> Maybe a
Just) (Either String Document -> IO (Maybe Document))
-> Either String Document -> IO (Maybe Document)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Document
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode (ByteString -> Either String Document)
-> ByteString -> Either String Document
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
HTTP.responseBody Response ByteString
resp
        Int
other -> String -> IO (Maybe Document)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (Maybe Document)) -> String -> IO (Maybe Document)
forall a b. (a -> b) -> a -> b
$ String
"Unexpected HTTP status " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
other