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.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425module State exposing ( Msg(..) , ThemeField(..) , decrementPending , defaultBasicTheme , docMatchesPub , documentUrl , errorFromBody , examples , extractBlobRef , extractCursor , getSelectedPub , init , initModel , isNonceRetry , normalizeHandle , originOf , subscriptions , update )
import Browserimport Browser.Navigation as Navimport Dateimport Dictimport Dpop exposing (PendingAction(..))import Fileimport File.Selectimport Httpimport Json.Decode as Decodeimport Json.Encode as Encodeimport Lexicons exposing (..)import Oauthimport Portsimport Processimport Randomimport Route exposing (Route(..))import Taskimport Timeimport Types exposing (..)import Urlimport Xrpc exposing (HttpResponse)
-- Login page cycling examples
examples : List Stringexamples = [ "Bluesky", "Blacksky", "Eurosky", "Tangled" ]
-- Publication editor
type ThemeField = Background | Foreground | Accent | AccentForeground
defaultBasicTheme : BasicThemedefaultBasicTheme = { background = RgbColor 255 255 255 , foreground = RgbColor 0 0 0 , accent = RgbColor 59 130 246 , accentForeground = RgbColor 255 255 255 }
setThemeField : ThemeField -> RgbColor -> BasicTheme -> BasicThemesetThemeField field color theme = case field of Background -> { theme | background = color }
Foreground -> { theme | foreground = color }
Accent -> { theme | accent = color }
AccentForeground -> { theme | accentForeground = color }
-- Init
init : Flags -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )init flags url key = let basePath : String basePath = Route.basePathFromAppUrl flags.appUrl
config : Config config = { clientName = flags.clientName , appUrl = flags.appUrl , basePath = basePath , plcDirectoryUrl = flags.plcDirectoryUrl , dohUrl = flags.dohUrl , bskyAppviewUrl = flags.bskyAppviewUrl }
clientId : String clientId = flags.appUrl ++ "/client-metadata.json"
redirectUri : String redirectUri = flags.appUrl ++ "/"
base : Model base = initModel config flags.jkt key clientId redirectUri
maybeSession : Maybe Session maybeSession = Decode.decodeValue sessionDecoder flags.session |> Result.toMaybe
maybePending : Maybe PendingOAuth maybePending = Decode.decodeValue pendingOAuthDecoder flags.pendingOAuth |> Result.toMaybe in case ( Route.getQueryParam "code" url, Route.getQueryParam "state" url, maybePending ) of ( Just code, Just stateParam, Just pending ) -> if stateParam == pending.state then ( { base | isLoading = True , oauthCode = code , oauthCodeVerifier = pending.codeVerifier , oauthState = pending.state , oauthTokenEndpoint = pending.tokenEndpoint , oauthPdsEndpoint = pending.pdsEndpoint , oauthDid = pending.did , oauthHandle = pending.handle } , Dpop.signFor ActionToken { htm = "POST" , htu = pending.tokenEndpoint , nonce = Nothing , accessToken = Nothing } )
else ( { base | error = Just "OAuth state mismatch" } , Ports.clearPendingOAuth () )
_ -> case maybeSession of Just session -> ( { base | page = Dashboard session , isLoading = True , pendingRequests = 2 , selectedPubRkey = Route.selectedFromRoute (Route.parseRoute url) } , Cmd.batch [ Dpop.signFor ActionListPublications (Dpop.xrpcSignInput session "listRecords") , Dpop.signFor ActionListDocuments (Dpop.xrpcSignInput session "listRecords") ] )
Nothing -> ( base, Cmd.none )
sessionDecoder : Decode.Decoder SessionsessionDecoder = Decode.map6 Session (Decode.field "did" Decode.string) (Decode.field "handle" Decode.string) (Decode.field "pdsEndpoint" Decode.string) (Decode.field "tokenEndpoint" Decode.string) (Decode.field "accessToken" Decode.string) (Decode.maybe (Decode.field "refreshToken" Decode.string))
pendingOAuthDecoder : Decode.Decoder PendingOAuthpendingOAuthDecoder = Decode.map6 PendingOAuth (Decode.field "state" Decode.string) (Decode.field "codeVerifier" Decode.string) (Decode.field "tokenEndpoint" Decode.string) (Decode.field "pdsEndpoint" Decode.string) (Decode.field "did" Decode.string) (Decode.field "handle" Decode.string)
initModel : Config -> String -> Nav.Key -> String -> String -> ModelinitModel config jkt key clientId redirectUri = { config = config , jkt = jkt , page = LoginView , navKey = key , clientId = clientId , redirectUri = redirectUri , handleInput = "" , error = Nothing , notification = Nothing , isLoading = False , pendingRequests = 0 , exampleIndex = 0 , examplePhase = Idle , publications = [] , selectedPubRkey = Nothing , draftPublication = Nothing , documents = [] , publicationsCursor = Nothing , documentsCursor = Nothing , pendingIconFile = Nothing , pendingActionId = Nothing , oauthCode = "" , oauthCodeVerifier = "" , oauthCodeChallenge = "" , oauthState = "" , oauthDid = "" , oauthHandle = "" , oauthPdsEndpoint = "" , oauthAuthorizationEndpoint = "" , oauthTokenEndpoint = "" , oauthParEndpoint = "" , oauthIssuer = "" , nonces = Dict.empty }
-- Subscriptions
subscriptions : Model -> Sub Msgsubscriptions model = Sub.batch [ Ports.onDpopSigned DpopSigned , Ports.onSha256 Sha256Computed , case model.page of LoginView -> Time.every 3000 (\_ -> RotateExample)
Dashboard _ -> Sub.none ]
-- Msg
type Msg = UpdateHandle String | StartLogin | StateGenerated String | VerifierGenerated String | Sha256Computed Decode.Value | HandleResolvedDoh (Result Http.Error String) | HandleResolvedWellKnown (Result Http.Error String) | HandleResolvedAppview (Result Http.Error String) | DidDocumentFetched (Result Http.Error String) | AuthServerFound (Result Http.Error String) | AuthMetadataFetched (Result Http.Error String) | DpopSigned Decode.Value | SignedResponse String (Result String HttpResponse) | SelectPublication (Maybe String) | InitPublication | UpdatePubName String | UpdatePubUrl String | UpdatePubDescription String | UpdatePubThemeColor ThemeField String | SetDefaultTheme | RemoveTheme | SetShowInDiscover Bool | RemovePreferences | PickIcon | IconFileSelected File.File | RemoveIcon | SavePublication | SaveWithTimestamp Time.Posix | RotateExample | FadeOutComplete | FadeInComplete | ClearNotification | ClearError | Logout | LinkClicked Browser.UrlRequest | UrlChanged Url.Url
-- Update
update : Msg -> Model -> ( Model, Cmd Msg )update msg model = case msg of UpdateHandle v -> ( { model | handleInput = v }, Cmd.none )
StartLogin -> let handle : String handle = normalizeHandle model.handleInput in if String.isEmpty handle then ( model, Cmd.none )
else ( { model | isLoading = True, error = Nothing, oauthHandle = handle } , Cmd.batch [ Random.generate VerifierGenerated Oauth.codeVerifierGenerator , Random.generate StateGenerated Oauth.stateGenerator ] )
StateGenerated s -> ( { model | oauthState = s }, Cmd.none )
VerifierGenerated v -> ( { model | oauthCodeVerifier = v } , Cmd.batch [ Ports.sha256 (Encode.object [ ( "id", Encode.string "challenge" ), ( "input", Encode.string v ) ]) , Oauth.resolveHandleViaDoh model.config.dohUrl model.oauthHandle HandleResolvedDoh ] )
Sha256Computed value -> case Decode.decodeValue Dpop.sha256Decoder value of Ok { id, v } -> if id == "challenge" then ( { model | oauthCodeChallenge = v }, Cmd.none )
else ( model, Cmd.none )
Err _ -> ( model, Cmd.none )
HandleResolvedDoh (Ok did) -> ( { model | oauthDid = String.trim did } , Oauth.fetchDidDocument model.config.plcDirectoryUrl (String.trim did) DidDocumentFetched )
HandleResolvedDoh (Err _) -> ( model, Oauth.resolveHandleViaWellKnown model.oauthHandle HandleResolvedWellKnown )
HandleResolvedWellKnown (Ok did) -> ( { model | oauthDid = String.trim did } , Oauth.fetchDidDocument model.config.plcDirectoryUrl (String.trim did) DidDocumentFetched )
HandleResolvedWellKnown (Err _) -> ( model, Oauth.resolveHandleViaAppview model.config.bskyAppviewUrl model.oauthHandle HandleResolvedAppview )
HandleResolvedAppview (Ok did) -> ( { model | oauthDid = did }, Oauth.fetchDidDocument model.config.plcDirectoryUrl did DidDocumentFetched )
HandleResolvedAppview (Err err) -> ( stopLoadingWithError ("Failed to resolve handle: " ++ httpErrorToString err) model, Cmd.none )
DidDocumentFetched (Ok body) -> case Oauth.extractPdsEndpoint body of Ok ( pdsEndpoint, maybeAuthServer ) -> case maybeAuthServer of Just authServer -> ( { model | oauthPdsEndpoint = pdsEndpoint, oauthIssuer = authServer } , Oauth.fetchAuthMetadata authServer AuthMetadataFetched )
Nothing -> ( { model | oauthPdsEndpoint = pdsEndpoint } , Oauth.fetchProtectedResource pdsEndpoint AuthServerFound )
Err decodeErr -> ( stopLoadingWithError ("Failed to parse DID document: " ++ decodeErr) model, Cmd.none )
DidDocumentFetched (Err err) -> ( stopLoadingWithError ("Failed to fetch DID document: " ++ httpErrorToString err) model, Cmd.none )
AuthServerFound (Ok body) -> case Oauth.extractAuthServerUrl body of Ok authServer -> ( { model | oauthIssuer = authServer }, Oauth.fetchAuthMetadata authServer AuthMetadataFetched )
Err decodeErr -> ( stopLoadingWithError ("Failed to find authorization server: " ++ decodeErr) model, Cmd.none )
AuthServerFound (Err err) -> ( stopLoadingWithError ("Failed to discover authorization server: " ++ httpErrorToString err) model, Cmd.none )
AuthMetadataFetched (Ok body) -> case Oauth.extractAuthEndpoints body of Ok endpoints -> let updated : Model updated = { model | oauthAuthorizationEndpoint = endpoints.authorizationEndpoint , oauthTokenEndpoint = endpoints.tokenEndpoint , oauthParEndpoint = endpoints.parEndpoint , oauthIssuer = endpoints.issuer } in ( updated , Dpop.signFor ActionPAR { htm = "POST" , htu = endpoints.parEndpoint , nonce = Dict.get (originOf endpoints.parEndpoint) model.nonces , accessToken = Nothing } )
Err decodeErr -> ( stopLoadingWithError ("Failed to parse auth metadata: " ++ decodeErr) model, Cmd.none )
AuthMetadataFetched (Err err) -> ( stopLoadingWithError ("Failed to fetch auth metadata: " ++ httpErrorToString err) model, Cmd.none )
DpopSigned value -> case Decode.decodeValue Dpop.dpopDecoder value of Ok (Ok { id, jwt }) -> dispatchSigned id jwt model
Ok (Err err) -> ( stopLoadingWithError ("DPoP sign error: " ++ err) model, Cmd.none )
Err decodeErr -> ( stopLoadingWithError ("DPoP port error: " ++ Decode.errorToString decodeErr) model, Cmd.none )
SignedResponse id result -> case ( Dpop.actionFromId id, result ) of ( Just action, Ok resp ) -> let updated : Model updated = storeNonce (originOf (htuFor action model)) resp model in if isNonceRetry resp then ( updated, retrySigned action updated resp )
else if isInvalidToken resp && action /= ActionRefresh then attemptRefresh id updated
else if resp.status >= 200 && resp.status < 300 then handleSuccess action resp.body updated
else ( stopLoadingWithError (errorFromBody resp) updated, Cmd.none )
( _, Err err ) -> ( stopLoadingWithError err model, Cmd.none )
( Nothing, _ ) -> ( stopLoadingWithError ("Unknown signed-response id: " ++ id) model, Cmd.none )
SelectPublication maybeRkey -> let route : Route route = case maybeRkey of Just rkey -> if String.isEmpty rkey then RouteNewPub
else RoutePub rkey
Nothing -> RouteHome
draft : Maybe Publication draft = if maybeRkey == Just "" then case model.draftPublication of Just _ -> model.draftPublication
Nothing -> Just emptyPublication
else Nothing in ( { model | selectedPubRkey = maybeRkey, draftPublication = draft } , Nav.pushUrl model.navKey (Route.routeToPath model.config.basePath route) )
InitPublication -> ( { model | draftPublication = Just emptyPublication , selectedPubRkey = Just "" } , Nav.pushUrl model.navKey (Route.routeToPath model.config.basePath RouteNewPub) )
UpdatePubName v -> updatePub (\p -> { p | name = v }) model
UpdatePubUrl v -> updatePub (\p -> { p | url = v }) model
UpdatePubDescription v -> updatePub (\p -> { p | description = if String.isEmpty v then Nothing
else Just v } ) model
UpdatePubThemeColor field hex -> case hexToRgb hex of Just rgb -> updatePub (\p -> { p | basicTheme = Just (setThemeField field rgb (Maybe.withDefault defaultBasicTheme p.basicTheme)) }) model
Nothing -> ( model, Cmd.none )
SetDefaultTheme -> updatePub (\p -> { p | basicTheme = Just defaultBasicTheme }) model
RemoveTheme -> updatePub (\p -> { p | basicTheme = Nothing }) model
SetShowInDiscover v -> updatePub (\p -> { p | preferences = Just { showInDiscover = Just v } }) model
RemovePreferences -> updatePub (\p -> { p | preferences = Nothing }) model
PickIcon -> ( model, File.Select.file [ "image/*" ] IconFileSelected )
IconFileSelected file -> case model.page of Dashboard session -> ( { model | pendingIconFile = Just file, isLoading = True } , Dpop.signFor ActionUploadIcon { htm = "POST" , htu = session.pdsEndpoint ++ "/xrpc/com.atproto.repo.uploadBlob" , nonce = Dict.get (originOf session.pdsEndpoint) model.nonces , accessToken = Just session.accessToken } )
LoginView -> ( model, Cmd.none )
RemoveIcon -> updatePub (\p -> { p | icon = Nothing }) model
SavePublication -> case ( model.page, getSelectedPub model ) of ( Dashboard _, Just pub ) -> if pub.createdAt == Nothing then ( model, Task.perform SaveWithTimestamp Time.now )
else startSave model
_ -> ( model, Cmd.none )
SaveWithTimestamp posix -> startSave (updatePubModel (\p -> { p | createdAt = Just (Date.isoFromPosix posix) }) model)
RotateExample -> ( { model | examplePhase = FadingOut } , Task.perform (\_ -> FadeOutComplete) (Process.sleep 250) )
FadeOutComplete -> ( { model | exampleIndex = remainderBy (List.length examples) (model.exampleIndex + 1) , examplePhase = FadingIn } , Task.perform (\_ -> FadeInComplete) (Process.sleep 250) )
FadeInComplete -> ( { model | examplePhase = Idle }, Cmd.none )
ClearNotification -> ( { model | notification = Nothing }, Cmd.none )
ClearError -> ( { model | error = Nothing }, Cmd.none )
Logout -> ( { model | page = LoginView , publications = [] , selectedPubRkey = Nothing , draftPublication = Nothing , documents = [] , nonces = Dict.empty , oauthCode = "" , oauthCodeVerifier = "" , oauthCodeChallenge = "" , oauthState = "" , oauthDid = "" , oauthHandle = "" , oauthPdsEndpoint = "" , oauthAuthorizationEndpoint = "" , oauthTokenEndpoint = "" , oauthParEndpoint = "" } , Cmd.batch [ Ports.clearSession (), Nav.pushUrl model.navKey (Route.routeToPath model.config.basePath RouteHome) ] )
LinkClicked urlRequest -> case urlRequest of Browser.Internal url -> ( model, Nav.pushUrl model.navKey (Url.toString url) )
Browser.External href -> ( model, Nav.load href )
UrlChanged url -> let selected : Maybe String selected = Route.selectedFromRoute (Route.parseRoute url)
draft : Maybe Publication draft = if selected == Just "" then case model.draftPublication of Just _ -> model.draftPublication
Nothing -> Just emptyPublication
else Nothing in ( { model | selectedPubRkey = selected, draftPublication = draft }, Cmd.none )
-- Dispatch: fire the actual HTTP request using the JWT we just received.
dispatchSigned : String -> String -> Model -> ( Model, Cmd Msg )dispatchSigned id jwt model = case Dpop.actionFromId id of Just ActionPAR -> ( model , Oauth.pushAuthorizationRequest { parEndpoint = model.oauthParEndpoint , clientId = model.clientId , redirectUri = model.redirectUri , codeChallenge = model.oauthCodeChallenge , state = model.oauthState , loginHint = model.oauthHandle , dpopJkt = model.jkt , jwt = jwt } (SignedResponse id) )
Just ActionToken -> ( model , Oauth.tokenExchange { tokenEndpoint = model.oauthTokenEndpoint , clientId = model.clientId , redirectUri = model.redirectUri , code = model.oauthCode , codeVerifier = model.oauthCodeVerifier , jwt = jwt } (SignedResponse id) )
Just ActionRefresh -> case ( model.page, model.page |> sessionRefreshToken ) of ( Dashboard session, Just rt ) -> ( model , Oauth.refreshToken { tokenEndpoint = session.tokenEndpoint , clientId = model.clientId , refreshToken = rt , jwt = jwt } (SignedResponse id) )
_ -> ( stopLoadingWithError "Refresh dispatch dropped: no refresh token" model, Cmd.none )
Just ActionListPublications -> case model.page of Dashboard session -> ( model, Xrpc.listRecords session "site.standard.publication" model.publicationsCursor jwt (SignedResponse id) )
LoginView -> ( stopLoadingWithError "listRecords dispatch dropped: not on dashboard" model, Cmd.none )
Just ActionListDocuments -> case model.page of Dashboard session -> ( model, Xrpc.listRecords session "site.standard.document" model.documentsCursor jwt (SignedResponse id) )
LoginView -> ( stopLoadingWithError "listRecords dispatch dropped: not on dashboard" model, Cmd.none )
Just ActionCreatePublication -> case ( model.page, getSelectedPub model ) of ( Dashboard session, Just pub ) -> ( model, Xrpc.createRecord session "site.standard.publication" (publicationRecordEncoder pub) jwt (SignedResponse id) )
_ -> ( stopLoadingWithError "createRecord dispatch dropped: selection lost" model, Cmd.none )
Just (ActionPutPublication rkey) -> case ( model.page, getSelectedPub model ) of ( Dashboard session, Just pub ) -> ( model, Xrpc.putRecord session "site.standard.publication" rkey (publicationRecordEncoder pub) jwt (SignedResponse id) )
_ -> ( stopLoadingWithError ("putRecord dispatch dropped: selection lost (rkey " ++ rkey ++ ")") model, Cmd.none )
Just ActionUploadIcon -> case ( model.page, model.pendingIconFile ) of ( Dashboard session, Just file ) -> ( model, Xrpc.uploadBlob session file jwt (SignedResponse id) )
_ -> ( stopLoadingWithError "uploadBlob dispatch dropped: no pending file" model, Cmd.none )
Nothing -> ( stopLoadingWithError ("Unknown DPoP action id: " ++ id) model, Cmd.none )
-- Success path per action.
handleSuccess : PendingAction -> String -> Model -> ( Model, Cmd Msg )handleSuccess action body model = case action of ActionPAR -> case Oauth.extractRequestUri body of Ok requestUri -> let authUrl : String authUrl = model.oauthAuthorizationEndpoint ++ "?client_id=" ++ Url.percentEncode model.clientId ++ "&request_uri=" ++ Url.percentEncode requestUri
pending : Encode.Value pending = Encode.object [ ( "state", Encode.string model.oauthState ) , ( "codeVerifier", Encode.string model.oauthCodeVerifier ) , ( "tokenEndpoint", Encode.string model.oauthTokenEndpoint ) , ( "pdsEndpoint", Encode.string model.oauthPdsEndpoint ) , ( "did", Encode.string model.oauthDid ) , ( "handle", Encode.string model.oauthHandle ) ] in ( model, Cmd.batch [ Ports.savePendingOAuth pending, Nav.load authUrl ] )
Err decodeErr -> ( stopLoadingWithError ("Failed to parse PAR response: " ++ decodeErr) model, Cmd.none )
ActionToken -> case Oauth.extractToken body of Ok { accessToken, refreshToken, sub } -> let session : Session session = { did = sub , handle = model.oauthHandle , pdsEndpoint = model.oauthPdsEndpoint , tokenEndpoint = model.oauthTokenEndpoint , accessToken = accessToken , refreshToken = refreshToken } in ( { model | page = Dashboard session , isLoading = True , pendingRequests = 2 , publications = [] , documents = [] , publicationsCursor = Nothing , documentsCursor = Nothing , oauthCode = "" , oauthCodeVerifier = "" , oauthState = "" } , Cmd.batch [ Ports.saveSession (Dpop.sessionEncoder session) , Ports.clearPendingOAuth () , Nav.pushUrl model.navKey (Route.routeToPath model.config.basePath RouteHome) , Dpop.signFor ActionListPublications (Dpop.xrpcSignInput session "listRecords") , Dpop.signFor ActionListDocuments (Dpop.xrpcSignInput session "listRecords") ] )
Err decodeErr -> ( stopLoadingWithError ("Failed to parse token response: " ++ decodeErr) model, Cmd.none )
ActionRefresh -> handleRefreshSuccess body model
ActionListPublications -> case Decode.decodeString (Decode.field "records" (Decode.list (Decode.maybe publicationListItemDecoder))) body of Ok maybePubs -> let pubs : List Publication pubs = List.filterMap identity maybePubs
skipped : Int skipped = List.length maybePubs - List.length pubs
updated : Model updated = { model | publications = model.publications ++ pubs , publicationsCursor = extractCursor body , notification = if skipped > 0 then Just ("Skipped " ++ String.fromInt skipped ++ " invalid publication record(s)")
else model.notification } in continueOrFinish ActionListPublications updated
Err decodeErr -> ( decrementPending { model | error = Just ("Failed to decode publications: " ++ Decode.errorToString decodeErr) } , Cmd.none )
ActionListDocuments -> case Decode.decodeString (Decode.field "records" (Decode.list (Decode.maybe (Decode.field "value" documentDecoder)))) body of Ok maybeDocs -> continueOrFinish ActionListDocuments { model | documents = model.documents ++ List.filterMap identity maybeDocs , documentsCursor = extractCursor body }
Err decodeErr -> ( decrementPending { model | error = Just ("Failed to decode documents: " ++ Decode.errorToString decodeErr) } , Cmd.none )
ActionCreatePublication -> updateSavedRkey body model
ActionPutPublication _ -> updateSavedRkey body model
ActionUploadIcon -> case extractBlobRef body of Ok blob -> ( updatePubModel (\p -> { p | icon = Just blob }) { model | isLoading = False, pendingIconFile = Nothing, notification = Just "Icon uploaded." } , Cmd.none )
Err decodeErr -> ( stopLoadingWithError ("Failed to parse blob response: " ++ decodeErr) { model | pendingIconFile = Nothing }, Cmd.none )
{-| After a list page response: if a non-empty cursor was returned, fetch thenext page; otherwise mark the collection as fully loaded.-}continueOrFinish : PendingAction -> Model -> ( Model, Cmd Msg )continueOrFinish action model = let cursor : Maybe String cursor = case action of ActionListPublications -> model.publicationsCursor
ActionListDocuments -> model.documentsCursor
_ -> Nothing in case ( model.page, cursor ) of ( Dashboard session, Just _ ) -> ( model, Dpop.signFor action (Dpop.xrpcSignInput session "listRecords") )
_ -> ( decrementPending model, Cmd.none )
extractBlobRef : String -> Result String BlobRefextractBlobRef body = Decode.decodeString (Decode.field "blob" blobRefDecoder) body |> Result.mapError Decode.errorToString
extractCursor : String -> Maybe StringextractCursor body = case Decode.decodeString (Decode.field "cursor" Decode.string) body of Ok c -> if String.isEmpty c then Nothing
else Just c
Err _ -> Nothing
updateSavedRkey : String -> Model -> ( Model, Cmd Msg )updateSavedRkey body model = case Decode.decodeString (Decode.field "uri" Decode.string) body of Ok uri -> let rkey : String rkey = uri |> String.split "/" |> List.reverse |> List.head |> Maybe.withDefault ""
previousRkey : String previousRkey = Maybe.withDefault "" model.selectedPubRkey
wasCreate : Bool wasCreate = String.isEmpty previousRkey
publications : List Publication publications = if wasCreate then case model.draftPublication of Just draft -> { draft | rkey = rkey } :: model.publications
Nothing -> model.publications
else List.map (\p -> if p.rkey == previousRkey then { p | rkey = rkey }
else p ) model.publications
cmd : Cmd Msg cmd = if previousRkey == rkey then Cmd.none
else Nav.replaceUrl model.navKey (Route.routeToPath model.config.basePath (RoutePub rkey)) in ( { model | publications = publications , draftPublication = if wasCreate then Nothing
else model.draftPublication , selectedPubRkey = Just rkey , isLoading = False , notification = Just "Publication saved!" } , cmd )
Err decodeErr -> ( stopLoadingWithError ("Save returned an unexpected response: " ++ Decode.errorToString decodeErr ++ " — body: " ++ body) model, Cmd.none )
-- Re-sign with the new DPoP-Nonce and retry the request.
retrySigned : PendingAction -> Model -> HttpResponse -> Cmd MsgretrySigned action model resp = let htu : String htu = htuFor action model
nonce : Maybe String nonce = case Dict.get "dpop-nonce" resp.headers of Just n -> Just n
Nothing -> Dict.get (originOf htu) model.nonces in Dpop.signFor action { htm = htmFor action , htu = htu , nonce = nonce , accessToken = accessTokenForAction action model }
htmFor : PendingAction -> StringhtmFor action = case action of ActionListPublications -> "GET"
ActionListDocuments -> "GET"
_ -> "POST"
htuFor : PendingAction -> Model -> StringhtuFor action model = case action of ActionPAR -> model.oauthParEndpoint
ActionToken -> model.oauthTokenEndpoint
ActionRefresh -> case model.page of Dashboard s -> s.tokenEndpoint
LoginView -> model.oauthTokenEndpoint
ActionListPublications -> sessionPds model ++ "/xrpc/com.atproto.repo.listRecords"
ActionListDocuments -> sessionPds model ++ "/xrpc/com.atproto.repo.listRecords"
ActionCreatePublication -> sessionPds model ++ "/xrpc/com.atproto.repo.createRecord"
ActionPutPublication _ -> sessionPds model ++ "/xrpc/com.atproto.repo.putRecord"
ActionUploadIcon -> sessionPds model ++ "/xrpc/com.atproto.repo.uploadBlob"
sessionPds : Model -> StringsessionPds model = case model.page of Dashboard s -> s.pdsEndpoint
LoginView -> model.oauthPdsEndpoint
accessTokenForAction : PendingAction -> Model -> Maybe StringaccessTokenForAction action model = case ( action, model.page ) of ( ActionPAR, _ ) -> Nothing
( ActionToken, _ ) -> Nothing
( ActionRefresh, _ ) -> Nothing
( _, Dashboard session ) -> Just session.accessToken
( _, LoginView ) -> Nothing
-- Helpers
normalizeHandle : String -> StringnormalizeHandle raw = let trimmed : String trimmed = String.trim raw in if String.startsWith "@" trimmed then String.dropLeft 1 trimmed
else trimmed
originOf : String -> StringoriginOf url = case Url.fromString url of Just u -> let scheme : String scheme = case u.protocol of Url.Http -> "http"
Url.Https -> "https"
portStr : String portStr = case u.port_ of Just p -> ":" ++ String.fromInt p
Nothing -> "" in scheme ++ "://" ++ u.host ++ portStr
Nothing -> url
storeNonce : String -> HttpResponse -> Model -> ModelstoreNonce origin resp model = case Dict.get "dpop-nonce" resp.headers of Just nonce -> { model | nonces = Dict.insert origin nonce model.nonces }
Nothing -> model
{-| Refresh succeeded: update session tokens, persist, re-sign the originalfailed action so its caller doesn't see the 401.-}handleRefreshSuccess : String -> Model -> ( Model, Cmd Msg )handleRefreshSuccess body model = case ( Oauth.extractToken body, model.page, model.pendingActionId ) of ( Ok t, Dashboard oldSession, Just pendingId ) -> let newSession : Session newSession = { oldSession | accessToken = t.accessToken , refreshToken = case t.refreshToken of Just _ -> t.refreshToken
Nothing -> oldSession.refreshToken }
updated : Model updated = { model | page = Dashboard newSession, pendingActionId = Nothing } in case Dpop.actionFromId pendingId of Just action -> ( updated , Cmd.batch [ Ports.saveSession (Dpop.sessionEncoder newSession) , Dpop.signFor action { htm = htmFor action , htu = htuFor action updated , nonce = Dict.get (originOf (htuFor action updated)) updated.nonces , accessToken = Just newSession.accessToken } ] )
Nothing -> ( stopLoadingWithError ("Refresh succeeded but pending action id is unknown: " ++ pendingId) updated , Ports.saveSession (Dpop.sessionEncoder newSession) )
( Err decodeErr, _, _ ) -> ( stopLoadingWithError ("Failed to parse refresh response: " ++ decodeErr) model, Cmd.none )
_ -> ( stopLoadingWithError "Refresh succeeded but session state is invalid." model, Cmd.none )
{-| Token expired (401 invalid\_token). Stash the failed action's id, sign aDPoP for the refresh request; on success we re-dispatch the original action.-}attemptRefresh : String -> Model -> ( Model, Cmd Msg )attemptRefresh failedId model = case ( model.page, model.page |> sessionRefreshToken ) of ( Dashboard session, Just _ ) -> ( { model | pendingActionId = Just failedId } , Dpop.signFor ActionRefresh { htm = "POST" , htu = session.tokenEndpoint , nonce = Dict.get (originOf session.tokenEndpoint) model.nonces , accessToken = Nothing } )
_ -> ( stopLoadingWithError "Session expired and no refresh token available. Please log in again." model , Ports.clearSession () )
sessionRefreshToken : Page -> Maybe StringsessionRefreshToken page = case page of Dashboard s -> s.refreshToken
LoginView -> Nothing
isInvalidToken : HttpResponse -> BoolisInvalidToken resp = resp.status == 401 && (case Decode.decodeString (Decode.field "error" Decode.string) resp.body of Ok "invalid_token" -> True
_ -> False )
isNonceRetry : HttpResponse -> BoolisNonceRetry resp = (resp.status == 400 || resp.status == 401) && (case Decode.decodeString (Decode.field "error" Decode.string) resp.body of Ok "use_dpop_nonce" -> True
_ -> False )
errorFromBody : HttpResponse -> StringerrorFromBody resp = case Decode.decodeString (Decode.field "error_description" Decode.string) resp.body of Ok msg -> "HTTP " ++ String.fromInt resp.status ++ ": " ++ msg
Err _ -> case Decode.decodeString (Decode.field "message" Decode.string) resp.body of Ok msg -> "HTTP " ++ String.fromInt resp.status ++ ": " ++ msg
Err _ -> "HTTP " ++ String.fromInt resp.status
decrementPending : { r | pendingRequests : Int, isLoading : Bool } -> { r | pendingRequests : Int, isLoading : Bool }decrementPending model = let next : Int next = max 0 (model.pendingRequests - 1) in { model | pendingRequests = next, isLoading = next > 0 }
stopLoadingWithError : String -> Model -> ModelstopLoadingWithError err model = { model | error = Just err, isLoading = False, pendingRequests = 0 }
getSelectedPub : Model -> Maybe PublicationgetSelectedPub model = case model.selectedPubRkey of Just "" -> model.draftPublication
Just rkey -> List.filter (\p -> p.rkey == rkey) model.publications |> List.head
Nothing -> Nothing
{-| A document belongs to a publication when its `site` field either matchesthe publication URL (legacy/loose documents) or the publication's at-uri`at://<did>/site.standard.publication/<rkey>`.-}docMatchesPub : String -> Publication -> Document -> BooldocMatchesPub did pub doc = (doc.site == pub.url) || (doc.site == "at://" ++ did ++ "/site.standard.publication/" ++ pub.rkey)
{-| Resolve a document's canonical URL. Use `doc.url` when present; otherwisefall back to `pub.url` + `doc.path`, normalizing the slash between them.Falls back to `pub.url` alone when path is absent.-}documentUrl : Publication -> Document -> StringdocumentUrl pub doc = case doc.url of Just u -> u
Nothing -> let base : String base = if String.endsWith "/" pub.url then String.dropRight 1 pub.url
else pub.url in case doc.path of Just p -> if String.startsWith "/" p then base ++ p
else base ++ "/" ++ p
Nothing -> pub.url
updatePub : (Publication -> Publication) -> Model -> ( Model, Cmd Msg )updatePub fn model = ( updatePubModel fn model, Cmd.none )
updatePubModel : (Publication -> Publication) -> Model -> ModelupdatePubModel fn model = case model.selectedPubRkey of Just "" -> { model | draftPublication = Maybe.map fn model.draftPublication }
Just rkey -> let apply : Publication -> Publication apply p = if p.rkey == rkey then fn p
else p in { model | publications = List.map apply model.publications }
Nothing -> model
startSave : Model -> ( Model, Cmd Msg )startSave model = case ( model.page, model.selectedPubRkey, getSelectedPub model ) of ( Dashboard session, Just rkey, Just _ ) -> let action : PendingAction action = if String.isEmpty rkey then ActionCreatePublication
else ActionPutPublication rkey in ( { model | isLoading = True } , Dpop.signFor action { htm = "POST" , htu = htuFor action model , nonce = Dict.get (originOf session.pdsEndpoint) model.nonces , accessToken = Just session.accessToken } )
_ -> ( model, Cmd.none )
httpErrorToString : Http.Error -> StringhttpErrorToString err = case err of Http.BadUrl url -> "Invalid URL: " ++ url
Http.Timeout -> "Request timed out"
Http.NetworkError -> "Network error"
Http.BadStatus status -> "HTTP " ++ String.fromInt status
Http.BadBody msg -> "Bad response: " ++ msg