diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,12 @@ +# 0.6.0.0 + +- add dDecodeEither method to DynamoEncodable for better error reporting +- removed hack for faulty AWSpager form 1.4.5 amazonka-dynamodb + +# 0.5.0.0 + +- Added UUID DynamoEncodable instance + # 0.4.0.1 - Fixed default signatures to compile with GHC 8.2 diff --git a/dynamodb-simple.cabal b/dynamodb-simple.cabal --- a/dynamodb-simple.cabal +++ b/dynamodb-simple.cabal @@ -1,5 +1,5 @@ name: dynamodb-simple -version: 0.5.0.0 +version: 0.6.0.0 synopsis: Typesafe library for working with DynamoDB database description: Framework for accessing DynamoDB database. The majority of AWS API is available to the user in a convenient, simple and typesafe manner. @@ -27,7 +27,7 @@ Database.DynamoDB.Internal, Database.DynamoDB.BatchRequest, Database.DynamoDB.QueryRequest, Database.DynamoDB.THLens, Database.DynamoDB.THContains, Database.DynamoDB.THConvert - build-depends: base >=4.8 && <5, amazonka-dynamodb >= 1.4.5, generics-sop, + build-depends: base >=4.9 && <5, amazonka-dynamodb >= 1.5.0, generics-sop, unordered-containers, text, lens, double-conversion, semigroups, bytestring >= 0.10.8.0, containers, monad-supply, template-haskell, transformers, exceptions, diff --git a/src/Database/DynamoDB.hs b/src/Database/DynamoDB.hs --- a/src/Database/DynamoDB.hs +++ b/src/Database/DynamoDB.hs @@ -95,7 +95,6 @@ import Data.Function ((&)) import Data.Proxy import Data.Semigroup ((<>)) -import qualified Data.Text as T import Network.AWS import qualified Network.AWS.DynamoDB.DeleteItem as D import qualified Network.AWS.DynamoDB.GetItem as D @@ -145,8 +144,8 @@ if | null result -> return Nothing | otherwise -> case dGsDecode result of - Just res -> return (Just res) - Nothing -> throwM (DynamoException $ "Cannot decode item: " <> T.pack (show result)) + Right res -> return (Just res) + Left err -> throwM (DynamoException $ "Cannot decode item: " <> err) -- | Delete item from the database by specifying the primary key. deleteItemByKey :: forall m a r. (MonadAWS m, DynamoTable a r) => Proxy a -> PrimaryKey a r -> m () @@ -207,8 +206,8 @@ | Just cmd <- dUpdateItem p pkey actions Nothing = do rs <- send (cmd & D.uiReturnValues .~ Just D.AllNew) case dGsDecode (rs ^. D.uirsAttributes) of - Just res -> return res - Nothing -> throwM (DynamoException $ "Cannot decode item: " <> T.pack (show rs)) + Right res -> return res + Left err -> throwM (DynamoException $ "Cannot decode item: " <> err) | otherwise = do rs <- getItem Strongly p pkey case rs of diff --git a/src/Database/DynamoDB/BatchRequest.hs b/src/Database/DynamoDB/BatchRequest.hs --- a/src/Database/DynamoDB/BatchRequest.hs +++ b/src/Database/DynamoDB/BatchRequest.hs @@ -98,8 +98,8 @@ mapM decoder (tbls ^.. ix tblname . traverse) decoder item = case dGsDecode item of - Just res -> return res - Nothing -> throwM (DynamoException $ "Error decoding item: " <> T.pack (show item)) + Right res -> return res + Left err -> throwM (DynamoException $ "Error decoding item: " <> err ) dDeleteRequest :: DynamoTable a r => Proxy a -> PrimaryKey a r -> D.DeleteRequest dDeleteRequest p pkey = D.deleteRequest & D.drKey .~ dKeyToAttr p pkey diff --git a/src/Database/DynamoDB/Class.hs b/src/Database/DynamoDB/Class.hs --- a/src/Database/DynamoDB/Class.hs +++ b/src/Database/DynamoDB/Class.hs @@ -14,7 +14,6 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} @@ -45,6 +44,7 @@ ) where import Control.Lens ((.~), sequenceOf, _2) +import Data.Bifunctor (first) import Data.Function ((&)) import qualified Data.HashMap.Strict as HMap import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty) @@ -79,8 +79,8 @@ => DynamoCollection a (r :: RangeType) (t :: TableType) | a -> r t where allFieldNames :: Proxy a -> [T.Text] primaryFields :: Proxy a -> [T.Text] - dGsDecode :: HashMap T.Text AttributeValue -> Maybe a - default dGsDecode :: (Code a ~ '[ xs ]) => HashMap T.Text AttributeValue -> Maybe a + dGsDecode :: HashMap T.Text AttributeValue -> Either T.Text a + default dGsDecode :: (Code a ~ '[ xs ]) => HashMap T.Text AttributeValue -> Either T.Text a dGsDecode = gsDecode class DynamoCollection a r t => HasPrimaryKey a (r :: RangeType) (t :: TableType) where @@ -235,19 +235,23 @@ gsDecode :: forall a r t xs. (DynamoCollection a r t, Code a ~ '[ xs ]) - => HashMap T.Text AttributeValue -> Maybe a + => HashMap T.Text AttributeValue -> Either T.Text a gsDecode = gsDecodeG (allFieldNames (Proxy :: Proxy a)) -- | Decode hashmap to a record using generic-sop. gsDecodeG :: forall a xs. (Generic a, All2 DynamoEncodable (Code a), Code a ~ '[ xs ]) - => [T.Text] -> HMap.HashMap T.Text AttributeValue -> Maybe a + => [T.Text] -> HMap.HashMap T.Text AttributeValue -> Either T.Text a gsDecodeG names attrs = - let Just vals = fromList $ map (`HMap.lookup` attrs) names - in to . SOP . Z <$> hsequence (hcliftA dproxy (dDecode . unK) vals) + let Just pairs = fromList $ map (\k -> (k, k `HMap.lookup` attrs)) names + in to . SOP . Z <$> hsequence (hcliftA dproxy (decodeWithErr . unK) pairs) where dproxy = Proxy :: Proxy DynamoEncodable - + decodeWithErr (k, Nothing) = first (("Error decoding empty attr: " <> k <> " -> ") <>) (dDecodeEither Nothing) + decodeWithErr (k, Just attr) = + first + (\err -> "Error decoding attr: " <> k <> " -> " <> err <> " from: " <> T.pack (show attr)) + (dDecodeEither (Just attr)) defaultPutItem :: forall a r. DynamoTable a r => a -> D.PutItem defaultPutItem item = D.putItem tblname & D.piItem .~ gsEncode item diff --git a/src/Database/DynamoDB/QueryRequest.hs b/src/Database/DynamoDB/QueryRequest.hs --- a/src/Database/DynamoDB/QueryRequest.hs +++ b/src/Database/DynamoDB/QueryRequest.hs @@ -48,7 +48,6 @@ import Control.Monad ((>=>)) import Control.Monad.Catch (throwM) import Data.Bool (bool) -import Data.Coerce (coerce) import Data.Conduit (Conduit, Source, (=$=)) import qualified Data.Conduit.List as CL import Data.Foldable (toList) @@ -66,7 +65,6 @@ import qualified Network.AWS.DynamoDB.Query as D import qualified Network.AWS.DynamoDB.Scan as D import qualified Network.AWS.DynamoDB.Types as D -import Network.AWS.Pager (AWSPager (..)) import Numeric.Natural (Natural) import qualified Data.HashMap.Strict as HMap @@ -81,8 +79,8 @@ => HashMap T.Text D.AttributeValue -> m a rsDecoder item = case dGsDecode item of - Just res -> return res - Nothing -> throwM (DynamoException $ "Error decoding item: " <> T.pack (show item)) + Right res -> return res + Left err -> throwM (DynamoException $ "Error decoding item: " <> err) -- | Options for a generic query. data QueryOpts a hash range = QueryOpts { @@ -122,36 +120,10 @@ addStartKey (Just (key, range)) = D.qExclusiveStartKey .~ dQueryKeyToAttr (Proxy :: Proxy a) (key, range) --- | When https://github.com/brendanhay/amazonka/issues/340 is fixed, remove -newtype FixedQuery = FixedQuery D.Query -instance AWSRequest FixedQuery where - type Rs FixedQuery = D.QueryResponse - request (FixedQuery a) = coerce (request a) - response lgr svc _ = response lgr svc (Proxy :: Proxy D.Query) -instance AWSPager FixedQuery where - page (FixedQuery dq) resp - | null lastkey = Nothing - | otherwise = Just $ FixedQuery (dq & D.qExclusiveStartKey .~ lastkey) - where - lastkey = resp ^. D.qrsLastEvaluatedKey - -newtype FixedScan = FixedScan D.Scan -instance AWSRequest FixedScan where - type Rs FixedScan = D.ScanResponse - request (FixedScan a) = coerce (request a) - response lgr svc _ = response lgr svc (Proxy :: Proxy D.Scan) -instance AWSPager FixedScan where - page (FixedScan dq) resp - | null lastkey = Nothing - | otherwise = Just $ FixedScan (dq & D.sExclusiveStartKey .~ lastkey) - where - lastkey = resp ^. D.srsLastEvaluatedKey - - -- | Same as 'querySource', but return data in original chunks. querySourceChunks :: forall a t m hash range. (CanQuery a t hash range, MonadAWS m) => Proxy a -> QueryOpts a hash range -> Source m [a] -querySourceChunks _ q = paginate (FixedQuery (queryCmd q)) =$= CL.mapM (\res -> mapM rsDecoder (res ^. D.qrsItems)) +querySourceChunks _ q = paginate (queryCmd q) =$= CL.mapM (\res -> mapM rsDecoder (res ^. D.qrsItems)) -- | Generic query function. You can query table or indexes that have -- a range key defined. The filter condition cannot access the hash and range keys. @@ -164,7 +136,7 @@ (DynamoIndex a parent 'NoRange, Code a ~ '[ hash ': rest ], DynamoScalar v1 hash, MonadAWS m, DynamoTable parent r) => Proxy a -> hash -> Source m [a] -querySourceChunksByKey p key = paginate (FixedQuery sQuery) =$= CL.mapM (\res -> mapM rsDecoder (res ^. D.qrsItems)) +querySourceChunksByKey p key = paginate sQuery =$= CL.mapM (\res -> mapM rsDecoder (res ^. D.qrsItems)) where sQuery = D.query (tableName (Proxy :: Proxy parent)) & D.qKeyConditionExpression .~ Just "#K = :key" @@ -304,7 +276,7 @@ -- | Conduit source for running scan; the same as 'scanSource', but return results in chunks as they come. scanSourceChunks :: (MonadAWS m, TableScan a r t) => Proxy a -> ScanOpts a r -> Source m [a] -scanSourceChunks _ q = paginate (FixedScan (scanCmd q)) =$= CL.mapM (\res -> mapM rsDecoder (res ^. D.srsItems)) +scanSourceChunks _ q = paginate (scanCmd q) =$= CL.mapM (\res -> mapM rsDecoder (res ^. D.srsItems)) -- | Conduit source for running a scan. scanSource :: (MonadAWS m, TableScan a r t) => Proxy a -> ScanOpts a r -> Source m a diff --git a/src/Database/DynamoDB/TH.hs b/src/Database/DynamoDB/TH.hs --- a/src/Database/DynamoDB/TH.hs +++ b/src/Database/DynamoDB/TH.hs @@ -288,8 +288,9 @@ lift [d| instance DynamoEncodable $(conT table) where dEncode val = Just (attributeValue & avM .~ gsEncodeG $(fieldList) val) - dDecode (Just attr) = gsDecodeG $(fieldList) (attr ^. avM) - dDecode Nothing = Nothing + dDecode = either (const Nothing) Just . dDecodeEither + dDecodeEither (Just attr) = gsDecodeG $(fieldList) (attr ^. avM) + dDecodeEither Nothing = Left "Missing value" |] >>= tell let constrs = mkConstrNames tblFieldNames forM_ constrs $ \constr -> diff --git a/src/Database/DynamoDB/Types.hs b/src/Database/DynamoDB/Types.hs --- a/src/Database/DynamoDB/Types.hs +++ b/src/Database/DynamoDB/Types.hs @@ -36,6 +36,7 @@ import Control.Exception (Exception) import Control.Lens ((.~), (^.)) import qualified Data.Aeson as AE +import Data.Bifunctor (first) import qualified Data.ByteString as BS import Data.ByteString.Lazy (toStrict) import Data.Double.Conversion.Text (toShortest) @@ -45,6 +46,7 @@ import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HMap import Data.Maybe (mapMaybe) +import Data.Monoid ((<>)) import Data.Proxy import Data.UUID.Types (UUID) import qualified Data.UUID.Types as UUID @@ -184,6 +186,13 @@ default dDecode :: (Show a, Read a) => Maybe AttributeValue -> Maybe a dDecode (Just attr) = attr ^. D.avS >>= (readMaybe . T.unpack) dDecode Nothing = Nothing + + -- | Decode data. Return (Left err) on parsing error, gets + -- 'Nothing' on input if the attribute was missing in the database. + -- The default instance uses dDecode, define this just for better errors + dDecodeEither :: Maybe AttributeValue -> Either T.Text a + dDecodeEither = maybe (Left "Decoding error") Right . dDecode + -- | Aid for searching for empty list and hashmap; these can be represented -- both by empty list and by missing value, if this returns true, enhance search. -- Also used by joins to weed out empty foreign keys @@ -192,40 +201,66 @@ instance DynamoEncodable Scientific where dEncode = Just . dScalarEncode - dDecode (Just attr) = attr ^. D.avN >>= AE.decodeStrict . encodeUtf8 - dDecode Nothing = Nothing -- Fail on missing attr + dDecode = either (const Nothing) Just . dDecodeEither + dDecodeEither (Just attr) = + maybe (Left "Missing value") Right (attr ^. D.avN) + >>= first T.pack . AE.eitherDecodeStrict . encodeUtf8 + dDecodeEither Nothing = Left "Missing attr" instance DynamoEncodable Integer where dEncode = Just . dScalarEncode - dDecode (Just attr) = attr ^. D.avN >>= AE.decodeStrict . encodeUtf8 - dDecode Nothing = Nothing -- Fail on missing attr + dDecode = either (const Nothing) Just . dDecodeEither + dDecodeEither (Just attr) = + maybe (Left "Missing value") Right (attr ^. D.avN) + >>= first T.pack . AE.eitherDecodeStrict . encodeUtf8 + dDecodeEither Nothing = Left "Missing attr" instance DynamoEncodable Int where dEncode = Just . dScalarEncode - dDecode (Just attr) = attr ^. D.avN >>= AE.decodeStrict . encodeUtf8 - dDecode Nothing = Nothing -- Fail on missing attr + dDecode = either (const Nothing) Just . dDecodeEither + dDecodeEither (Just attr) = + maybe (Left "Missing value") Right (attr ^. D.avN) + >>= first T.pack . AE.eitherDecodeStrict . encodeUtf8 + dDecodeEither Nothing = Left "Missing attr" instance DynamoEncodable Word where dEncode = Just . dScalarEncode - dDecode (Just attr) = attr ^. D.avN >>= AE.decodeStrict . encodeUtf8 - dDecode Nothing = Nothing -- Fail on missing attr + dDecode = either (const Nothing) Just . dDecodeEither + dDecodeEither (Just attr) = + maybe (Left "Missing value") Right (attr ^. D.avN) + >>= first T.pack . AE.eitherDecodeStrict . encodeUtf8 + dDecodeEither Nothing = Left "Missing attr" instance DynamoEncodable Int16 where dEncode = Just . dScalarEncode - dDecode (Just attr) = attr ^. D.avN >>= AE.decodeStrict . encodeUtf8 - dDecode Nothing = Nothing -- Fail on missing attr + dDecode = either (const Nothing) Just . dDecodeEither + dDecodeEither (Just attr) = + maybe (Left "Missing value") Right (attr ^. D.avN) + >>= first T.pack . AE.eitherDecodeStrict . encodeUtf8 + dDecodeEither Nothing = Left "Missing attr" instance DynamoEncodable Int32 where dEncode = Just . dScalarEncode - dDecode (Just attr) = attr ^. D.avN >>= AE.decodeStrict . encodeUtf8 - dDecode Nothing = Nothing -- Fail on missing attr + dDecode = either (const Nothing) Just . dDecodeEither + dDecodeEither (Just attr) = + maybe (Left "Missing value") Right (attr ^. D.avN) + >>= first T.pack . AE.eitherDecodeStrict . encodeUtf8 + dDecodeEither Nothing = Left "Missing attr" instance DynamoEncodable Int64 where dEncode = Just . dScalarEncode - dDecode (Just attr) = attr ^. D.avN >>= AE.decodeStrict . encodeUtf8 - dDecode Nothing = Nothing -- Fail on missing attr + dDecode = either (const Nothing) Just . dDecodeEither + dDecodeEither (Just attr) = + maybe (Left "Missing value") Right (attr ^. D.avN) + >>= first T.pack . AE.eitherDecodeStrict . encodeUtf8 + dDecodeEither Nothing = Left "Missing attr" instance DynamoEncodable Double where dEncode num = Just $ attributeValue & D.avN .~ (Just $ toShortest num) - dDecode (Just attr) = attr ^. D.avN >>= AE.decodeStrict . encodeUtf8 - dDecode Nothing = Nothing -- Fail on missing attr + dDecode = either (const Nothing) Just . dDecodeEither + dDecodeEither (Just attr) = + maybe (Left "Missing value") Right (attr ^. D.avN) + >>= first T.pack . AE.eitherDecodeStrict . encodeUtf8 + dDecodeEither Nothing = Left "Missing attr" instance DynamoEncodable Bool where dEncode b = Just $ attributeValue & D.avBOOL .~ Just b - dDecode (Just attr) = attr ^. D.avBOOL - dDecode Nothing = Nothing + dDecode = either (const Nothing) Just . dDecodeEither + dDecodeEither (Just attr) = maybe (Left "Missing value") Right (attr ^. D.avBOOL) + dDecodeEither Nothing = Left "Missing attr" + instance DynamoEncodable T.Text where dEncode "" = Nothing dEncode txt = Just (dScalarEncode txt) @@ -255,8 +290,9 @@ instance DynamoEncodable a => DynamoEncodable (Maybe a) where dEncode Nothing = Nothing dEncode (Just key) = dEncode key - dDecode Nothing = Just Nothing - dDecode (Just attr) = Just <$> dDecode (Just attr) + dDecode = either (const Nothing) Just . dDecodeEither + dDecodeEither Nothing = Right Nothing + dDecodeEither (Just attr) = Just <$> dDecodeEither (Just attr) dIsMissing Nothing = True dIsMissing _ = False instance (Ord a, DynamoScalar v a) => DynamoEncodable (Set.Set a) where @@ -264,25 +300,30 @@ dEncode dta = Just $ dSetEncode dta dDecode (Just attr) = dSetDecode attr dDecode Nothing = Just Set.empty + dDecodeEither (Just attr) = maybe (Left "Error decoding set") Right (dSetDecode attr) + dDecodeEither Nothing = Right Set.empty instance (IsText t, DynamoEncodable a) => DynamoEncodable (HashMap t a) where dEncode dta = let textmap = HMap.fromList $ mapMaybe (\(key, val) -> (toText key,) <$> dEncode val) $ HMap.toList dta in Just $ attributeValue & D.avM .~ textmap - dDecode (Just attr) = - let attrlist = traverse (\(key, val) -> (fromText key,) <$> dDecode (Just val)) $ HMap.toList (attr ^. D.avM) - in HMap.fromList <$> attrlist - dDecode Nothing = Just mempty + dDecode = either (const Nothing) Just . dDecodeEither + dDecodeEither (Just attr) = + let attrlist = traverse (\(key, val) -> (fromText key,) <$> dDecodeEither (Just val)) $ HMap.toList (attr ^. D.avM) + in HMap.fromList <$> attrlist + dDecodeEither Nothing = Right mempty dIsMissing = null -- | DynamoDB cannot represent empty items; ['Maybe' a] will lose Nothings. instance DynamoEncodable a => DynamoEncodable [a] where dEncode lst = Just $ attributeValue & D.avL .~ mapMaybe dEncode lst - dDecode (Just attr) = traverse (dDecode . Just) (attr ^. D.avL) - dDecode Nothing = Just mempty + dDecode = either (const Nothing) Just . dDecodeEither + dDecodeEither (Just attr) = traverse (dDecodeEither . Just) (attr ^. D.avL) + dDecodeEither Nothing = Right mempty dIsMissing = null instance {-# OVERLAPPABLE #-} DynamoEncodable a => DynamoEncodable (Tagged v a) where dEncode = dEncode . unTagged dDecode a = Tagged <$> dDecode a + dDecodeEither a = Tagged <$> dDecodeEither a dIsMissing = dIsMissing . unTagged -- | Partial encoding/decoding Aeson values. Empty strings get converted to NULL. @@ -294,19 +335,21 @@ dEncode (AE.Bool b) = dEncode b dEncode AE.Null = Just $ attributeValue & D.avNULL .~ Just True -- - dDecode Nothing = Just AE.Null - dDecode (Just attr) = -- Ok, this is going to be very hacky... + dDecode = either (const Nothing) Just . dDecodeEither + + dDecodeEither Nothing = Right AE.Null + dDecodeEither (Just attr) = -- Ok, this is going to be very hacky... case AE.toJSON attr of AE.Object obj -> case HMap.toList obj of - [("BOOL", AE.Bool val)] -> Just (AE.Bool val) - [("L", _)] -> (AE.Array .V.fromList) <$> mapM (dDecode . Just) (attr ^. D.avL) - [("M", _)] -> AE.Object <$> mapM (dDecode . Just) (attr ^. D.avM) - [("N", AE.String num)] -> AE.decodeStrict (encodeUtf8 num) - [("N", num@(AE.Number _))] -> Just num -- Just in case, this is usually not returned - [("S", AE.String val)] -> Just (AE.String val) - [("NULL", _)] -> Just AE.Null - _ -> Nothing - _ -> Nothing -- This shouldn't happen + [("BOOL", AE.Bool val)] -> Right (AE.Bool val) + [("L", _)] -> (AE.Array .V.fromList) <$> mapM (dDecodeEither . Just) (attr ^. D.avL) + [("M", _)] -> AE.Object <$> mapM (dDecodeEither . Just) (attr ^. D.avM) + [("N", AE.String num)] -> first T.pack (AE.eitherDecodeStrict (encodeUtf8 num)) + [("N", num@(AE.Number _))] -> Right num -- Just in case, this is usually not returned + [("S", AE.String val)] -> Right (AE.String val) + [("NULL", _)] -> Right AE.Null + _ -> Left ("Undecodable json value: " <> decodeUtf8 (toStrict (AE.encode obj))) + _ -> Left "Wrong dynamo data" -- This shouldn't happen -- dIsMissing AE.Null = True dIsMissing _ = False