Handle HTTP status in index lookup

This commit is contained in:
Emi Simpson 2022-11-05 14:50:34 -04:00
parent c12ceba496
commit 2ff873b070
Signed by: Emi
GPG Key ID: A12F2C2FFDC3D847
1 changed files with 14 additions and 8 deletions

View File

@ -53,6 +53,7 @@ data AviaryError
| StrangeIndex
| IndexMissingField String
| ImageNotFound
| IndexNotFound
type Image =
{ key :: Aff CryptoKey
@ -77,6 +78,7 @@ instance showAviaryError :: Show AviaryError where
show StrangeIndex = "The gallery index matched with the provided key, but was in a strange format. This could indicate a severe version mismatch, or that the gallery was created by a malfunctioning client."
show (IndexMissingField f) = "The gallery index was missing the crucial field " <> f <> ". This is almost certainly the result of a version mismatch or that the creator's client was not fully up-to-spec."
show ImageNotFound = "The image was not found, likely indicating that it expired"
show IndexNotFound = "The index was not found, likely indicating that the gallery never existed or expired"
show (UnexpectedStatusCode status) = "Server returned an unexpected status code: " <> (show status)
type UrlInfo =
@ -173,14 +175,18 @@ main_aff = do
Right keyBuffer -> do
cryptoKey <- importKey keyBuffer
{ status, arrayBuffer } <- fetch (urlInfo.server <> "/" <> urlInfo.fileId <> ".bin") {}
encryptedIndex <- arrayBuffer
serializedIndex <- try $ decryptBlob cryptoKey encryptedIndex urlInfo.nonce
case serializedIndex of
Left err -> do
_ <- liftEffect $ log $ message err
pure $ Left $ DecryptFailed
Right serializedIndex' -> do
liftEffect $ parseIndex serializedIndex'
case status of
200 -> do
encryptedIndex <- arrayBuffer
serializedIndex <- try $ decryptBlob cryptoKey encryptedIndex urlInfo.nonce
case serializedIndex of
Left err -> do
_ <- liftEffect $ log $ message err
pure $ Left $ DecryptFailed
Right serializedIndex' -> do
liftEffect $ parseIndex serializedIndex'
404 -> pure $ Left ImageNotFound
s -> pure $ Left $ if s / 100 == 5 then ServerError else UnexpectedStatusCode s
maybeUrls <- case maybeIndex of
Left err -> pure $ Left err
Right index -> Right <$> parTraverse (fetchImageAsBlobUrl urlInfo.nonce) index.images