Something went wrong. Try again.
📰 A single-page application to manage standard.site publication on the AT Protocol cuducos.tngl.io/std-pub
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387module Oauth exposing ( AuthEndpoints , TokenResponse , codeVerifierGenerator , dnsTxtDecoder , encodeFormBody , extractAuthEndpoints , extractAuthServerUrl , extractPdsEndpoint , extractRequestUri , extractToken , fetchAuthMetadata , fetchDidDocument , fetchProtectedResource , pushAuthorizationRequest , refreshToken , resolveHandleViaAppview , resolveHandleViaDoh , resolveHandleViaWellKnown , stateGenerator , tokenExchange )
import Httpimport Json.Decode as Decodeimport Json.Encode as Encodeimport Randomimport Urlimport Xrpc exposing (HttpResponse, expectResponse)
-- Handle resolution
resolveHandleViaDoh : String -> String -> (Result Http.Error String -> msg) -> Cmd msgresolveHandleViaDoh dohUrl handle tagger = Http.request { method = "GET" , headers = [ Http.header "Accept" "application/dns-json" ] , url = dohUrl ++ "?name=_atproto." ++ handle ++ "&type=TXT" , body = Http.emptyBody , expect = Http.expectJson tagger (dnsTxtDecoder handle) , timeout = Just 5000 , tracker = Nothing }
resolveHandleViaWellKnown : String -> (Result Http.Error String -> msg) -> Cmd msgresolveHandleViaWellKnown handle tagger = Http.request { method = "GET" , headers = [] , url = "https://" ++ handle ++ "/.well-known/atproto-did" , body = Http.emptyBody , expect = Http.expectString tagger , timeout = Just 5000 , tracker = Nothing }
resolveHandleViaAppview : String -> String -> (Result Http.Error String -> msg) -> Cmd msgresolveHandleViaAppview appviewUrl handle tagger = Http.get { url = appviewUrl ++ "/xrpc/com.atproto.identity.resolveHandle?handle=" ++ Url.percentEncode handle , expect = Http.expectJson tagger (Decode.field "did" Decode.string) }
dnsTxtDecoder : String -> Decode.Decoder StringdnsTxtDecoder handle = Decode.maybe (Decode.field "Answer" (Decode.list txtRecordDecoder)) |> Decode.andThen (\answers -> case answers of Just (first :: _) -> Decode.succeed first
_ -> Decode.fail ("No TXT record for _atproto." ++ handle) )
txtRecordDecoder : Decode.Decoder StringtxtRecordDecoder = Decode.field "data" Decode.string |> Decode.andThen (\data -> let cleaned : String cleaned = String.filter (\c -> c /= '"') data in if String.startsWith "did=" cleaned then Decode.succeed (String.dropLeft 4 cleaned)
else Decode.fail ("Unexpected TXT: " ++ cleaned) )
-- Discovery
fetchDidDocument : String -> String -> (Result Http.Error String -> msg) -> Cmd msgfetchDidDocument plcDirectoryUrl did tagger = if String.startsWith "did:web:" did then Http.get { url = "https://" ++ String.dropLeft 8 did ++ "/.well-known/did.json" , expect = Http.expectString tagger }
else Http.get { url = plcDirectoryUrl ++ "/" ++ did , expect = Http.expectString tagger }
fetchProtectedResource : String -> (Result Http.Error String -> msg) -> Cmd msgfetchProtectedResource pdsEndpoint tagger = Http.get { url = pdsEndpoint ++ "/.well-known/oauth-protected-resource" , expect = Http.expectString tagger }
fetchAuthMetadata : String -> (Result Http.Error String -> msg) -> Cmd msgfetchAuthMetadata authServerUrl tagger = Http.get { url = authServerUrl ++ "/.well-known/oauth-authorization-server" , expect = Http.expectString tagger }
-- PAR + token exchange
pushAuthorizationRequest : { parEndpoint : String , clientId : String , redirectUri : String , codeChallenge : String , state : String , loginHint : String , dpopJkt : String , jwt : String } -> (Result String HttpResponse -> msg) -> Cmd msgpushAuthorizationRequest p tagger = let body : String body = encodeFormBody [ ( "response_type", "code" ) , ( "client_id", p.clientId ) , ( "redirect_uri", p.redirectUri ) , ( "scope", "atproto repo:site.standard.publication?action=create&action=update blob?accept=image/*" ) , ( "code_challenge", p.codeChallenge ) , ( "code_challenge_method", "S256" ) , ( "state", p.state ) , ( "login_hint", p.loginHint ) , ( "dpop_jkt", p.dpopJkt ) ] in Http.request { method = "POST" , headers = [ Http.header "DPoP" p.jwt ] , url = p.parEndpoint , body = Http.stringBody "application/x-www-form-urlencoded" body , expect = expectResponse tagger , timeout = Nothing , tracker = Nothing }
refreshToken : { tokenEndpoint : String , clientId : String , refreshToken : String , jwt : String } -> (Result String HttpResponse -> msg) -> Cmd msgrefreshToken p tagger = let body : String body = encodeFormBody [ ( "grant_type", "refresh_token" ) , ( "refresh_token", p.refreshToken ) , ( "client_id", p.clientId ) ] in Http.request { method = "POST" , headers = [ Http.header "DPoP" p.jwt ] , url = p.tokenEndpoint , body = Http.stringBody "application/x-www-form-urlencoded" body , expect = expectResponse tagger , timeout = Nothing , tracker = Nothing }
tokenExchange : { tokenEndpoint : String , clientId : String , redirectUri : String , code : String , codeVerifier : String , jwt : String } -> (Result String HttpResponse -> msg) -> Cmd msgtokenExchange p tagger = let body : String body = encodeFormBody [ ( "grant_type", "authorization_code" ) , ( "code", p.code ) , ( "code_verifier", p.codeVerifier ) , ( "redirect_uri", p.redirectUri ) , ( "client_id", p.clientId ) ] in Http.request { method = "POST" , headers = [ Http.header "DPoP" p.jwt ] , url = p.tokenEndpoint , body = Http.stringBody "application/x-www-form-urlencoded" body , expect = expectResponse tagger , timeout = Nothing , tracker = Nothing }
-- Response parsers
extractPdsEndpoint : String -> Result String ( String, Maybe String )extractPdsEndpoint body = Decode.decodeString (Decode.field "service" (Decode.list serviceDecoder) |> Decode.andThen (\services -> case findPdsService services of Just ( pds, authServer ) -> Decode.succeed ( pds, authServer )
Nothing -> Decode.fail "No #atproto_pds service found" ) ) body |> Result.mapError Decode.errorToString
extractAuthServerUrl : String -> Result String StringextractAuthServerUrl body = Decode.decodeString (Decode.field "authorization_servers" (Decode.index 0 Decode.string)) body |> Result.mapError Decode.errorToString
type alias AuthEndpoints = { authorizationEndpoint : String , tokenEndpoint : String , parEndpoint : String , issuer : String }
extractAuthEndpoints : String -> Result String AuthEndpointsextractAuthEndpoints body = Decode.decodeString (Decode.map4 AuthEndpoints (Decode.field "authorization_endpoint" Decode.string) (Decode.field "token_endpoint" Decode.string) (Decode.field "pushed_authorization_request_endpoint" Decode.string) (Decode.field "issuer" Decode.string) ) body |> Result.mapError Decode.errorToString
extractRequestUri : String -> Result String StringextractRequestUri body = Decode.decodeString (Decode.field "request_uri" Decode.string) body |> Result.mapError Decode.errorToString
type alias TokenResponse = { accessToken : String , refreshToken : Maybe String , sub : String }
extractToken : String -> Result String TokenResponseextractToken body = Decode.decodeString (Decode.map3 TokenResponse (Decode.field "access_token" Decode.string) (Decode.maybe (Decode.field "refresh_token" Decode.string)) (Decode.field "sub" Decode.string) ) body |> Result.mapError Decode.errorToString
-- DID doc helpers
type alias ServiceEntry = { id : String , endpoint : String , authServer : Maybe String }
serviceDecoder : Decode.Decoder ServiceEntryserviceDecoder = Decode.map3 ServiceEntry (Decode.field "id" Decode.string) (Decode.field "serviceEndpoint" Decode.string) (Decode.maybe (Decode.field "authorization_server" Decode.string))
findPdsService : List ServiceEntry -> Maybe ( String, Maybe String )findPdsService services = services |> List.filter (\s -> s.id == "#atproto_pds") |> List.head |> Maybe.map (\s -> ( s.endpoint, s.authServer ))
-- Random generators
unreserved : Stringunreserved = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-._~"
codeVerifierGenerator : Random.Generator StringcodeVerifierGenerator = Random.list 64 (randomCharFrom unreserved) |> Random.map String.fromList
stateGenerator : Random.Generator StringstateGenerator = Random.list 32 (randomCharFrom unreserved) |> Random.map String.fromList
randomCharFrom : String -> Random.Generator CharrandomCharFrom source = Random.int 0 (String.length source - 1) |> Random.map (\i -> String.dropLeft i source |> String.uncons |> Maybe.map Tuple.first |> Maybe.withDefault 'A' )
-- Form encoding
encodeFormBody : List ( String, String ) -> StringencodeFormBody pairs = pairs |> List.map (\( k, v ) -> k ++ "=" ++ Url.percentEncode v) |> String.join "&"