Handle HTTP status in index lookup
This commit is contained in:
parent
c12ceba496
commit
2ff873b070
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue