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

View file

@ -53,6 +53,7 @@ data AviaryError
| StrangeIndex | StrangeIndex
| IndexMissingField String | IndexMissingField String
| ImageNotFound | ImageNotFound
| IndexNotFound
type Image = type Image =
{ key :: Aff CryptoKey { 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 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 (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 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) show (UnexpectedStatusCode status) = "Server returned an unexpected status code: " <> (show status)
type UrlInfo = type UrlInfo =
@ -173,14 +175,18 @@ main_aff = do
Right keyBuffer -> do Right keyBuffer -> do
cryptoKey <- importKey keyBuffer cryptoKey <- importKey keyBuffer
{ status, arrayBuffer } <- fetch (urlInfo.server <> "/" <> urlInfo.fileId <> ".bin") {} { status, arrayBuffer } <- fetch (urlInfo.server <> "/" <> urlInfo.fileId <> ".bin") {}
encryptedIndex <- arrayBuffer case status of
serializedIndex <- try $ decryptBlob cryptoKey encryptedIndex urlInfo.nonce 200 -> do
case serializedIndex of encryptedIndex <- arrayBuffer
Left err -> do serializedIndex <- try $ decryptBlob cryptoKey encryptedIndex urlInfo.nonce
_ <- liftEffect $ log $ message err case serializedIndex of
pure $ Left $ DecryptFailed Left err -> do
Right serializedIndex' -> do _ <- liftEffect $ log $ message err
liftEffect $ parseIndex serializedIndex' 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 maybeUrls <- case maybeIndex of
Left err -> pure $ Left err Left err -> pure $ Left err
Right index -> Right <$> parTraverse (fetchImageAsBlobUrl urlInfo.nonce) index.images Right index -> Right <$> parTraverse (fetchImageAsBlobUrl urlInfo.nonce) index.images