1{-# LANGUAGE CPP #-} 2{-# LANGUAGE DeriveDataTypeable #-} 3{-# LANGUAGE FlexibleContexts #-} 4{-# LANGUAGE FlexibleInstances #-} 5{-# LANGUAGE GeneralizedNewtypeDeriving #-} 6{-# LANGUAGE MultiParamTypeClasses #-} 7{-# LANGUAGE NoMonomorphismRestriction #-} 8{-# LANGUAGE OverloadedStrings #-} 9{-# LANGUAGE RecordWildCards #-} 10{-# LANGUAGE ScopedTypeVariables #-} 11{-# LANGUAGE TypeFamilies #-} 12{-# LANGUAGE UndecidableInstances #-} 13 14----------------------------------------------------------------------------- 15-- | 16-- Module : Aws.DynamoDb.Core 17-- Copyright : Soostone Inc, Chris Allen 18-- License : BSD3 19-- 20-- Maintainer : Ozgun Ataman <ozgun.ataman@soostone.com> 21-- Stability : experimental 22-- 23-- Shared types and utilities for DyanmoDb functionality. 24---------------------------------------------------------------------------- 25 26module Aws.DynamoDb.Core 27 ( 28 -- * Configuration and Regions 29 Region (..) 30 , ddbLocal 31 , ddbUsEast1 32 , ddbUsWest1 33 , ddbUsWest2 34 , ddbEuWest1 35 , ddbEuWest2 36 , ddbEuCentral1 37 , ddbApNe1 38 , ddbApSe1 39 , ddbApSe2 40 , ddbSaEast1 41 , DdbConfiguration (..) 42 43 -- * DynamoDB values 44 , DValue (..) 45 46 -- * Converting to/from 'DValue' 47 , DynVal(..) 48 , toValue, fromValue 49 , Bin (..) 50 , OldBool(..) 51 52 -- * Defining new 'DynVal' instances 53 , DynData(..) 54 , DynBinary(..), DynNumber(..), DynString(..), DynBool(..) 55 56 -- * Working with key/value pairs 57 , Attribute (..) 58 , parseAttributeJson 59 , attributeJson 60 , attributesJson 61 62 , attrTuple 63 , attr 64 , attrAs 65 , text, int, double 66 , PrimaryKey (..) 67 , hk 68 , hrk 69 70 -- * Working with objects (attribute collections) 71 , Item 72 , item 73 , attributes 74 , ToDynItem (..) 75 , FromDynItem (..) 76 , fromItem 77 , Parser (..) 78 , getAttr 79 , getAttr' 80 , parseAttr 81 82 -- * Common types used by operations 83 , Conditions (..) 84 , conditionsJson 85 , expectsJson 86 87 , Condition (..) 88 , conditionJson 89 , CondOp (..) 90 , CondMerge (..) 91 , ConsumedCapacity (..) 92 , ReturnConsumption (..) 93 , ItemCollectionMetrics (..) 94 , ReturnItemCollectionMetrics (..) 95 , UpdateReturn (..) 96 , QuerySelect (..) 97 , querySelectJson 98 99 -- * Size estimation 100 , DynSize (..) 101 , nullAttr 102 103 -- * Responses & Errors 104 , DdbResponse (..) 105 , DdbErrCode (..) 106 , shouldRetry 107 , DdbError (..) 108 109 -- * Internal Helpers 110 , ddbSignQuery 111 , AmazonError (..) 112 , ddbResponseConsumer 113 , ddbHttp 114 , ddbHttps 115 116 ) where 117 118 119------------------------------------------------------------------------------- 120import Control.Applicative 121import qualified Control.Exception as C 122import Control.Monad 123#if MIN_VERSION_base(4,9,0) 124import qualified Control.Monad.Fail as Fail 125#endif 126import Control.Monad.Trans 127import Control.Monad.Trans.Resource (throwM) 128import qualified Crypto.Hash as CH 129import Data.Aeson 130import qualified Data.Aeson as A 131import Data.Aeson.Types (Pair, parseEither) 132import qualified Data.Aeson.Types as A 133import qualified Data.Attoparsec.ByteString as AttoB (endOfInput) 134import qualified Data.Attoparsec.Text as Atto 135import qualified Data.ByteArray as ByteArray 136import qualified Data.ByteString.Base16 as Base16 137import qualified Data.ByteString.Base64 as Base64 138import qualified Data.ByteString.Char8 as B 139import qualified Data.CaseInsensitive as CI 140import Data.Conduit 141import Data.Conduit.Attoparsec (sinkParser) 142import Data.Default 143import Data.Function (on) 144import qualified Data.HashMap.Strict as HM 145import Data.Int 146import Data.IORef 147import Data.List 148import qualified Data.Map as M 149import Data.Maybe 150import Data.Monoid () 151import qualified Data.Semigroup as Sem 152import Data.Proxy 153import Data.Scientific 154import qualified Data.Serialize as Ser 155import qualified Data.Set as S 156import Data.String 157import Data.Tagged 158import qualified Data.Text as T 159import qualified Data.Text.Encoding as T 160import Data.Time 161import Data.Typeable 162import qualified Data.Vector as V 163import Data.Word 164import qualified Network.HTTP.Conduit as HTTP 165import qualified Network.HTTP.Types as HTTP 166import Safe 167------------------------------------------------------------------------------- 168import Aws.Core 169------------------------------------------------------------------------------- 170 171------------------------------------------------------------------------------- 172-- | Boolean values stored in DynamoDb. Only used in defining new 173-- 'DynVal' instances. 174newtype DynBool = DynBool { unDynBool :: Bool } 175 deriving (Eq,Show,Read,Ord,Typeable) 176 177 178------------------------------------------------------------------------------- 179-- | Numeric values stored in DynamoDb. Only used in defining new 180-- 'DynVal' instances. 181newtype DynNumber = DynNumber { unDynNumber :: Scientific } 182 deriving (Eq,Show,Read,Ord,Typeable) 183 184 185------------------------------------------------------------------------------- 186-- | String values stored in DynamoDb. Only used in defining new 187-- 'DynVal' instances. 188newtype DynString = DynString { unDynString :: T.Text } 189 deriving (Eq,Show,Read,Ord,Typeable) 190 191 192------------------------------------------------------------------------------- 193-- | Binary values stored in DynamoDb. Only used in defining new 194-- 'DynVal' instances. 195newtype DynBinary = DynBinary { unDynBinary :: B.ByteString } 196 deriving (Eq,Show,Read,Ord,Typeable) 197 198 199------------------------------------------------------------------------------- 200-- | An internally used closed typeclass for values that have direct 201-- DynamoDb representations. Based on AWS API, this is basically 202-- numbers, strings and binary blobs. 203-- 204-- This is here so that any 'DynVal' haskell value can automatically 205-- be lifted to a list or a 'Set' without any instance code 206-- duplication. 207-- 208-- Do not try to create your own instances. 209class Ord a => DynData a where 210 fromData :: a -> DValue 211 toData :: DValue -> Maybe a 212 213instance DynData DynBool where 214 fromData (DynBool i) = DBool i 215 toData (DBool i) = Just $ DynBool i 216 toData (DNum i) = DynBool `fmap` do 217 (i' :: Int) <- toIntegral i 218 case i' of 219 0 -> return False 220 1 -> return True 221 _ -> Nothing 222 toData _ = Nothing 223 224instance DynData (S.Set DynBool) where 225 fromData set = DBoolSet (S.map unDynBool set) 226 toData (DBoolSet i) = Just $ S.map DynBool i 227 toData _ = Nothing 228 229instance DynData DynNumber where 230 fromData (DynNumber i) = DNum i 231 toData (DNum i) = Just $ DynNumber i 232 toData _ = Nothing 233 234instance DynData (S.Set DynNumber) where 235 fromData set = DNumSet (S.map unDynNumber set) 236 toData (DNumSet i) = Just $ S.map DynNumber i 237 toData _ = Nothing 238 239instance DynData DynString where 240 fromData (DynString i) = DString i 241 toData (DString i) = Just $ DynString i 242 toData _ = Nothing 243 244instance DynData (S.Set DynString) where 245 fromData set = DStringSet (S.map unDynString set) 246 toData (DStringSet i) = Just $ S.map DynString i 247 toData _ = Nothing 248 249instance DynData DynBinary where 250 fromData (DynBinary i) = DBinary i 251 toData (DBinary i) = Just $ DynBinary i 252 toData _ = Nothing 253 254instance DynData (S.Set DynBinary) where 255 fromData set = DBinSet (S.map unDynBinary set) 256 toData (DBinSet i) = Just $ S.map DynBinary i 257 toData _ = Nothing 258 259instance DynData DValue where 260 fromData = id 261 toData = Just 262 263 264------------------------------------------------------------------------------- 265-- | Class of Haskell types that can be represented as DynamoDb values. 266-- 267-- This is the conversion layer; instantiate this class for your own 268-- types and then use the 'toValue' and 'fromValue' combinators to 269-- convert in application code. 270-- 271-- Each Haskell type instantiated with this class will map to a 272-- DynamoDb-supported type that most naturally represents it. 273class DynData (DynRep a) => DynVal a where 274 275 -- | Which of the 'DynData' instances does this data type directly 276 -- map to? 277 type DynRep a 278 279 -- | Convert to representation 280 toRep :: a -> DynRep a 281 282 -- | Convert from representation 283 fromRep :: DynRep a -> Maybe a 284 285 286------------------------------------------------------------------------------- 287-- | Any singular 'DynVal' can be upgraded to a list. 288instance (DynData (DynRep [a]), DynVal a) => DynVal [a] where 289 type DynRep [a] = S.Set (DynRep a) 290 fromRep set = mapM fromRep $ S.toList set 291 toRep as = S.fromList $ map toRep as 292 293 294------------------------------------------------------------------------------- 295-- | Any singular 'DynVal' can be upgraded to a 'Set'. 296instance (DynData (DynRep (S.Set a)), DynVal a, Ord a) => DynVal (S.Set a) where 297 type DynRep (S.Set a) = S.Set (DynRep a) 298 fromRep set = fmap S.fromList . mapM fromRep $ S.toList set 299 toRep as = S.map toRep as 300 301 302instance DynVal DValue where 303 type DynRep DValue = DValue 304 fromRep = Just 305 toRep = id 306 307instance DynVal Bool where 308 type DynRep Bool = DynBool 309 fromRep (DynBool i) = Just i 310 toRep i = DynBool i 311 312instance DynVal Int where 313 type DynRep Int = DynNumber 314 fromRep (DynNumber i) = toIntegral i 315 toRep i = DynNumber (fromIntegral i) 316 317 318instance DynVal Int8 where 319 type DynRep Int8 = DynNumber 320 fromRep (DynNumber i) = toIntegral i 321 toRep i = DynNumber (fromIntegral i) 322 323 324instance DynVal Int16 where 325 type DynRep Int16 = DynNumber 326 fromRep (DynNumber i) = toIntegral i 327 toRep i = DynNumber (fromIntegral i) 328 329 330instance DynVal Int32 where 331 type DynRep Int32 = DynNumber 332 fromRep (DynNumber i) = toIntegral i 333 toRep i = DynNumber (fromIntegral i) 334 335 336instance DynVal Int64 where 337 type DynRep Int64 = DynNumber 338 fromRep (DynNumber i) = toIntegral i 339 toRep i = DynNumber (fromIntegral i) 340 341 342instance DynVal Word8 where 343 type DynRep Word8 = DynNumber 344 fromRep (DynNumber i) = toIntegral i 345 toRep i = DynNumber (fromIntegral i) 346 347 348instance DynVal Word16 where 349 type DynRep Word16 = DynNumber 350 fromRep (DynNumber i) = toIntegral i 351 toRep i = DynNumber (fromIntegral i) 352 353 354instance DynVal Word32 where 355 type DynRep Word32 = DynNumber 356 fromRep (DynNumber i) = toIntegral i 357 toRep i = DynNumber (fromIntegral i) 358 359 360instance DynVal Word64 where 361 type DynRep Word64 = DynNumber 362 fromRep (DynNumber i) = toIntegral i 363 toRep i = DynNumber (fromIntegral i) 364 365 366instance DynVal Integer where 367 type DynRep Integer = DynNumber 368 fromRep (DynNumber i) = toIntegral i 369 toRep i = DynNumber (fromIntegral i) 370 371 372instance DynVal T.Text where 373 type DynRep T.Text = DynString 374 fromRep (DynString i) = Just i 375 toRep i = DynString i 376 377 378instance DynVal B.ByteString where 379 type DynRep B.ByteString = DynBinary 380 fromRep (DynBinary i) = Just i 381 toRep i = DynBinary i 382 383 384instance DynVal Double where 385 type DynRep Double = DynNumber 386 fromRep (DynNumber i) = Just $ toRealFloat i 387 toRep i = DynNumber (fromFloatDigits i) 388 389 390------------------------------------------------------------------------------- 391-- | Encoded as number of days 392instance DynVal Day where 393 type DynRep Day = DynNumber 394 fromRep (DynNumber i) = ModifiedJulianDay <$> (toIntegral i) 395 toRep (ModifiedJulianDay i) = DynNumber (fromIntegral i) 396 397 398------------------------------------------------------------------------------- 399-- | Losslessly encoded via 'Integer' picoseconds 400instance DynVal UTCTime where 401 type DynRep UTCTime = DynNumber 402 fromRep num = fromTS <$> fromRep num 403 toRep x = toRep (toTS x) 404 405 406------------------------------------------------------------------------------- 407pico :: Rational 408pico = toRational $ (10 :: Integer) ^ (12 :: Integer) 409 410 411------------------------------------------------------------------------------- 412dayPico :: Integer 413dayPico = 86400 * round pico 414 415 416------------------------------------------------------------------------------- 417-- | Convert UTCTime to picoseconds 418-- 419-- TODO: Optimize performance? 420toTS :: UTCTime -> Integer 421toTS (UTCTime (ModifiedJulianDay i) diff) = i' + diff' 422 where 423 diff' = floor (toRational diff * pico) 424 i' = i * dayPico 425 426 427------------------------------------------------------------------------------- 428-- | Convert picoseconds to UTCTime 429-- 430-- TODO: Optimize performance? 431fromTS :: Integer -> UTCTime 432fromTS i = UTCTime (ModifiedJulianDay days) diff 433 where 434 (days, secs) = i `divMod` dayPico 435 diff = fromRational ((toRational secs) / pico) 436 437 438 439-- | Type wrapper for binary data to be written to DynamoDB. Wrap any 440-- 'Serialize' instance in there and 'DynVal' will know how to 441-- automatically handle conversions in binary form. 442newtype Bin a = Bin { getBin :: a } 443 deriving (Eq,Show,Read,Ord,Typeable,Enum) 444 445 446instance (Ser.Serialize a) => DynVal (Bin a) where 447 type DynRep (Bin a) = DynBinary 448 toRep (Bin i) = DynBinary (Ser.encode i) 449 fromRep (DynBinary i) = either (const Nothing) (Just . Bin) $ 450 Ser.decode i 451 452newtype OldBool = OldBool Bool 453 454instance DynVal OldBool where 455 type DynRep OldBool = DynNumber 456 fromRep (DynNumber i) = OldBool `fmap` do 457 (i' :: Int) <- toIntegral i 458 case i' of 459 0 -> return False 460 1 -> return True 461 _ -> Nothing 462 toRep (OldBool b) = DynNumber (if b then 1 else 0) 463 464 465------------------------------------------------------------------------------- 466-- | Encode a Haskell value. 467toValue :: DynVal a => a -> DValue 468toValue a = fromData $ toRep a 469 470 471------------------------------------------------------------------------------- 472-- | Decode a Haskell value. 473fromValue :: DynVal a => DValue -> Maybe a 474fromValue d = toData d >>= fromRep 475 476 477toIntegral :: (Integral a, RealFrac a1) => a1 -> Maybe a 478toIntegral sc = Just $ floor sc 479 480 481 482-- | Value types natively recognized by DynamoDb. We pretty much 483-- exactly reflect the AWS API onto Haskell types. 484data DValue 485 = DNull 486 | DNum Scientific 487 | DString T.Text 488 | DBinary B.ByteString 489 -- ^ Binary data will automatically be base64 marshalled. 490 | DNumSet (S.Set Scientific) 491 | DStringSet (S.Set T.Text) 492 | DBinSet (S.Set B.ByteString) 493 -- ^ Binary data will automatically be base64 marshalled. 494 | DBool Bool 495 | DBoolSet (S.Set Bool) 496 -- ^ Composite data 497 | DList (V.Vector DValue) 498 | DMap (M.Map T.Text DValue) 499 deriving (Eq,Show,Read,Ord,Typeable) 500 501 502instance IsString DValue where 503 fromString t = DString (T.pack t) 504 505------------------------------------------------------------------------------- 506-- | Primary keys consist of either just a Hash key (mandatory) or a 507-- hash key and a range key (optional). 508data PrimaryKey = PrimaryKey { 509 pkHash :: Attribute 510 , pkRange :: Maybe Attribute 511 } deriving (Read,Show,Ord,Eq,Typeable) 512 513 514------------------------------------------------------------------------------- 515-- | Construct a hash-only primary key. 516-- 517-- >>> hk "user-id" "ABCD" 518-- 519-- >>> hk "user-id" (mkVal 23) 520hk :: T.Text -> DValue -> PrimaryKey 521hk k v = PrimaryKey (attr k v) Nothing 522 523 524------------------------------------------------------------------------------- 525-- | Construct a hash-and-range primary key. 526hrk :: T.Text -- ^ Hash key name 527 -> DValue -- ^ Hash key value 528 -> T.Text -- ^ Range key name 529 -> DValue -- ^ Range key value 530 -> PrimaryKey 531hrk k v k2 v2 = PrimaryKey (attr k v) (Just (attr k2 v2)) 532 533 534instance ToJSON PrimaryKey where 535 toJSON (PrimaryKey h Nothing) = toJSON h 536 toJSON (PrimaryKey h (Just r)) = 537 let Object p1 = toJSON h 538 Object p2 = toJSON r 539 in Object (p1 `HM.union` p2) 540 541instance FromJSON PrimaryKey where 542 parseJSON p = do 543 l <- listPKey p 544 case length l of 545 1 -> return $ head l 546 _ -> fail "Unable to parse PrimaryKey" 547 where listPKey p'= map (\(txt,dval)-> hk txt dval) 548 . HM.toList <$> parseJSON p' 549 550 551-- | A key-value pair 552data Attribute = Attribute { 553 attrName :: T.Text 554 , attrVal :: DValue 555 } deriving (Read,Show,Ord,Eq,Typeable) 556 557 558-- | Convert attribute to a tuple representation 559attrTuple :: Attribute -> (T.Text, DValue) 560attrTuple (Attribute a b) = (a,b) 561 562 563-- | Convenience function for constructing key-value pairs 564attr :: DynVal a => T.Text -> a -> Attribute 565attr k v = Attribute k (toValue v) 566 567 568-- | 'attr' with type witness to help with cases where you're manually 569-- supplying values in code. 570-- 571-- >> item [ attrAs text "name" "john" ] 572attrAs :: DynVal a => Proxy a -> T.Text -> a -> Attribute 573attrAs _ k v = attr k v 574 575 576-- | Type witness for 'Text'. See 'attrAs'. 577text :: Proxy T.Text 578text = Proxy 579 580 581-- | Type witness for 'Integer'. See 'attrAs'. 582int :: Proxy Integer 583int = Proxy 584 585 586-- | Type witness for 'Double'. See 'attrAs'. 587double :: Proxy Double 588double = Proxy 589 590 591-- | A DynamoDb object is simply a key-value dictionary. 592type Item = M.Map T.Text DValue 593 594 595------------------------------------------------------------------------------- 596-- | Pack a list of attributes into an Item. 597item :: [Attribute] -> Item 598item = M.fromList . map attrTuple 599 600 601------------------------------------------------------------------------------- 602-- | Unpack an 'Item' into a list of attributes. 603attributes :: M.Map T.Text DValue -> [Attribute] 604attributes = map (\ (k, v) -> Attribute k v) . M.toList 605 606 607showT :: Show a => a -> T.Text 608showT = T.pack . show 609 610 611instance ToJSON DValue where 612 toJSON DNull = object ["NULL" .= True] 613 toJSON (DNum i) = object ["N" .= showT i] 614 toJSON (DString i) = object ["S" .= i] 615 toJSON (DBinary i) = object ["B" .= (T.decodeUtf8 $ Base64.encode i)] 616 toJSON (DNumSet i) = object ["NS" .= map showT (S.toList i)] 617 toJSON (DStringSet i) = object ["SS" .= S.toList i] 618 toJSON (DBinSet i) = object ["BS" .= map (T.decodeUtf8 . Base64.encode) (S.toList i)] 619 toJSON (DBool i) = object ["BOOL" .= i] 620 toJSON (DList i) = object ["L" .= i] 621 toJSON (DMap i) = object ["M" .= i] 622 toJSON x = error $ "aws: bug: DynamoDB can't handle " ++ show x 623 624 625instance FromJSON DValue where 626 parseJSON o = do 627 (obj :: [(T.Text, Value)]) <- M.toList `liftM` parseJSON o 628 case obj of 629 [("NULL", _)] -> return DNull 630 [("N", numStr)] -> DNum <$> parseScientific numStr 631 [("S", str)] -> DString <$> parseJSON str 632 [("B", bin)] -> do 633 res <- (Base64.decode . T.encodeUtf8) <$> parseJSON bin 634 either fail (return . DBinary) res 635 [("NS", s)] -> do xs <- mapM parseScientific =<< parseJSON s 636 return $ DNumSet $ S.fromList xs 637 [("SS", s)] -> DStringSet <$> parseJSON s 638 [("BS", s)] -> do 639 xs <- mapM (either fail return . Base64.decode . T.encodeUtf8) 640 =<< parseJSON s 641 return $ DBinSet $ S.fromList xs 642 [("BOOL", b)] -> DBool <$> parseJSON b 643 [("L", attrs)] -> DList <$> parseJSON attrs 644 [("M", attrs)] -> DMap <$> parseJSON attrs 645 646 x -> fail $ "aws: unknown dynamodb value: " ++ show x 647 648 where 649 parseScientific (String str) = 650 case Atto.parseOnly Atto.scientific str of 651 Left e -> fail ("parseScientific failed: " ++ e) 652 Right a -> return a 653 parseScientific (Number n) = return n 654 parseScientific _ = fail "Unexpected JSON type in parseScientific" 655 656 657instance ToJSON Attribute where 658 toJSON a = object $ [attributeJson a] 659 660 661------------------------------------------------------------------------------- 662-- | Parse a JSON object that contains attributes 663parseAttributeJson :: Value -> A.Parser [Attribute] 664parseAttributeJson (Object v) = mapM conv $ HM.toList v 665 where 666 conv (k, o) = Attribute k <$> parseJSON o 667parseAttributeJson _ = error "Attribute JSON must be an Object" 668 669 670-- | Convert into JSON object for AWS. 671attributesJson :: [Attribute] -> Value 672attributesJson as = object $ map attributeJson as 673 674 675-- | Convert into JSON pair 676attributeJson :: Attribute -> Pair 677attributeJson (Attribute nm v) = nm .= v 678 679 680------------------------------------------------------------------------------- 681-- | Errors defined by AWS. 682data DdbErrCode 683 = AccessDeniedException 684 | ConditionalCheckFailedException 685 | IncompleteSignatureException 686 | InvalidSignatureException 687 | LimitExceededException 688 | MissingAuthenticationTokenException 689 | ProvisionedThroughputExceededException 690 | ResourceInUseException 691 | ResourceNotFoundException 692 | ThrottlingException 693 | ValidationException 694 | RequestTooLarge 695 | InternalFailure 696 | InternalServerError 697 | ServiceUnavailableException 698 | SerializationException 699 -- ^ Raised by AWS when the request JSON is missing fields or is 700 -- somehow malformed. 701 deriving (Read,Show,Eq,Typeable) 702 703 704------------------------------------------------------------------------------- 705-- | Whether the action should be retried based on the received error. 706shouldRetry :: DdbErrCode -> Bool 707shouldRetry e = go e 708 where 709 go LimitExceededException = True 710 go ProvisionedThroughputExceededException = True 711 go ResourceInUseException = True 712 go ThrottlingException = True 713 go InternalFailure = True 714 go InternalServerError = True 715 go ServiceUnavailableException = True 716 go _ = False 717 718 719------------------------------------------------------------------------------- 720-- | Errors related to this library. 721data DdbLibraryError 722 = UnknownDynamoErrCode T.Text 723 -- ^ A DynamoDB error code we do not know about. 724 | JsonProtocolError Value T.Text 725 -- ^ A JSON response we could not parse. 726 deriving (Show,Eq,Typeable) 727 728 729-- | Potential errors raised by DynamoDB 730data DdbError = DdbError { 731 ddbStatusCode :: Int 732 -- ^ 200 if successful, 400 for client errors and 500 for 733 -- server-side errors. 734 , ddbErrCode :: DdbErrCode 735 , ddbErrMsg :: T.Text 736 } deriving (Show,Eq,Typeable) 737 738 739instance C.Exception DdbError 740instance C.Exception DdbLibraryError 741 742 743-- | Response metadata that is present in every DynamoDB response. 744data DdbResponse = DdbResponse { 745 ddbrCrc :: Maybe T.Text 746 , ddbrMsgId :: Maybe T.Text 747 } 748 749 750instance Loggable DdbResponse where 751 toLogText (DdbResponse id2 rid) = 752 "DynamoDB: request ID=" `mappend` 753 fromMaybe "<none>" rid `mappend` 754 ", x-amz-id-2=" `mappend` 755 fromMaybe "<none>" id2 756 757instance Sem.Semigroup DdbResponse where 758 a <> b = DdbResponse (ddbrCrc a `mplus` ddbrCrc b) (ddbrMsgId a `mplus` ddbrMsgId b) 759 760instance Monoid DdbResponse where 761 mempty = DdbResponse Nothing Nothing 762 mappend = (Sem.<>) 763 764 765data Region = Region { 766 rUri :: B.ByteString 767 , rName :: B.ByteString 768 } deriving (Eq,Show,Read,Typeable) 769 770 771data DdbConfiguration qt = DdbConfiguration { 772 ddbcRegion :: Region 773 -- ^ The regional endpoint. Ex: 'ddbUsEast' 774 , ddbcProtocol :: Protocol 775 -- ^ 'HTTP' or 'HTTPS' 776 , ddbcPort :: Maybe Int 777 -- ^ Port override (mostly for local dev connection) 778 } deriving (Show,Typeable) 779 780instance Default (DdbConfiguration NormalQuery) where 781 def = DdbConfiguration ddbUsEast1 HTTPS Nothing 782 783instance DefaultServiceConfiguration (DdbConfiguration NormalQuery) where 784 defServiceConfig = ddbHttps ddbUsEast1 785 debugServiceConfig = ddbHttp ddbUsEast1 786 787 788------------------------------------------------------------------------------- 789-- | DynamoDb local connection (for development) 790ddbLocal :: Region 791ddbLocal = Region "127.0.0.1" "local" 792 793ddbUsEast1 :: Region 794ddbUsEast1 = Region "dynamodb.us-east-1.amazonaws.com" "us-east-1" 795 796ddbUsWest1 :: Region 797ddbUsWest1 = Region "dynamodb.us-west-1.amazonaws.com" "us-west-1" 798 799ddbUsWest2 :: Region 800ddbUsWest2 = Region "dynamodb.us-west-2.amazonaws.com" "us-west-2" 801 802ddbEuWest1 :: Region 803ddbEuWest1 = Region "dynamodb.eu-west-1.amazonaws.com" "eu-west-1" 804 805ddbEuWest2 :: Region 806ddbEuWest2 = Region "dynamodb.eu-west-2.amazonaws.com" "eu-west-2" 807 808ddbEuCentral1 :: Region 809ddbEuCentral1 = Region "dynamodb.eu-central-1.amazonaws.com" "eu-central-1" 810 811ddbApNe1 :: Region 812ddbApNe1 = Region "dynamodb.ap-northeast-1.amazonaws.com" "ap-northeast-1" 813 814ddbApSe1 :: Region 815ddbApSe1 = Region "dynamodb.ap-southeast-1.amazonaws.com" "ap-southeast-1" 816 817ddbApSe2 :: Region 818ddbApSe2 = Region "dynamodb.ap-southeast-2.amazonaws.com" "ap-southeast-2" 819 820ddbSaEast1 :: Region 821ddbSaEast1 = Region "dynamodb.sa-east-1.amazonaws.com" "sa-east-1" 822 823ddbHttp :: Region -> DdbConfiguration NormalQuery 824ddbHttp endpoint = DdbConfiguration endpoint HTTP Nothing 825 826ddbHttps :: Region -> DdbConfiguration NormalQuery 827ddbHttps endpoint = DdbConfiguration endpoint HTTPS Nothing 828 829 830ddbSignQuery 831 :: A.ToJSON a 832 => B.ByteString 833 -> a 834 -> DdbConfiguration qt 835 -> SignatureData 836 -> SignedQuery 837ddbSignQuery target body di sd 838 = SignedQuery { 839 sqMethod = Post 840 , sqProtocol = ddbcProtocol di 841 , sqHost = host 842 , sqPort = fromMaybe (defaultPort (ddbcProtocol di)) (ddbcPort di) 843 , sqPath = "/" 844 , sqQuery = [] 845 , sqDate = Just $ signatureTime sd 846 , sqAuthorization = Just auth 847 , sqContentType = Just "application/x-amz-json-1.0" 848 , sqContentMd5 = Nothing 849 , sqAmzHeaders = amzHeaders ++ maybe [] (\tok -> [("x-amz-security-token",tok)]) (iamToken credentials) 850 , sqOtherHeaders = [] 851 , sqBody = Just $ HTTP.RequestBodyLBS bodyLBS 852 , sqStringToSign = canonicalRequest 853 } 854 where 855 credentials = signatureCredentials sd 856 857 Region{..} = ddbcRegion di 858 host = rUri 859 860 sigTime = fmtTime "%Y%m%dT%H%M%SZ" $ signatureTime sd 861 862 bodyLBS = A.encode body 863 bodyHash = Base16.encode $ ByteArray.convert (CH.hashlazy bodyLBS :: CH.Digest CH.SHA256) 864 865 -- for some reason AWS doesn't want the x-amz-security-token in the canonical request 866 amzHeaders = [ ("x-amz-date", sigTime) 867 , ("x-amz-target", dyApiVersion Sem.<> target) 868 ] 869 870 canonicalHeaders = sortBy (compare `on` fst) $ amzHeaders ++ 871 [("host", host), 872 ("content-type", "application/x-amz-json-1.0")] 873 874 canonicalRequest = B.concat $ intercalate ["\n"] ( 875 [ ["POST"] 876 , ["/"] 877 , [] -- query string 878 ] ++ 879 map (\(a,b) -> [CI.foldedCase a,":",b]) canonicalHeaders ++ 880 [ [] -- end headers 881 , intersperse ";" (map (CI.foldedCase . fst) canonicalHeaders) 882 , [bodyHash] 883 ]) 884 885 auth = authorizationV4 sd HmacSHA256 rName "dynamodb" 886 "content-type;host;x-amz-date;x-amz-target" 887 canonicalRequest 888 889data AmazonError = AmazonError { 890 aeType :: T.Text 891 , aeMessage :: Maybe T.Text 892 } 893 894instance FromJSON AmazonError where 895 parseJSON (Object v) = AmazonError 896 <$> v .: "__type" 897 <*> (Just <$> (v .: "message" <|> v .: "Message") <|> pure Nothing) 898 parseJSON _ = error $ "aws: unexpected AmazonError message" 899 900 901 902 903------------------------------------------------------------------------------- 904ddbResponseConsumer :: A.FromJSON a => IORef DdbResponse -> HTTPResponseConsumer a 905ddbResponseConsumer ref resp = do 906 val <- runConduit $ HTTP.responseBody resp .| sinkParser (A.json' <* AttoB.endOfInput) 907 case statusCode of 908 200 -> rSuccess val 909 _ -> rError val 910 where 911 912 header = fmap T.decodeUtf8 . flip lookup (HTTP.responseHeaders resp) 913 amzId = header "x-amzn-RequestId" 914 amzCrc = header "x-amz-crc32" 915 meta = DdbResponse amzCrc amzId 916 tellMeta = liftIO $ tellMetadataRef ref meta 917 918 rSuccess val = 919 case A.fromJSON val of 920 A.Success a -> return a 921 A.Error err -> do 922 tellMeta 923 throwM $ JsonProtocolError val (T.pack err) 924 925 rError val = do 926 tellMeta 927 case parseEither parseJSON val of 928 Left e -> 929 throwM $ JsonProtocolError val (T.pack e) 930 931 Right err'' -> do 932 let e = T.drop 1 . snd . T.breakOn "#" $ aeType err'' 933 errCode <- readErrCode e 934 throwM $ DdbError statusCode errCode (fromMaybe "" $ aeMessage err'') 935 936 readErrCode txt = 937 let txt' = T.unpack txt 938 in case readMay txt' of 939 Just e -> return $ e 940 Nothing -> throwM (UnknownDynamoErrCode txt) 941 942 HTTP.Status{..} = HTTP.responseStatus resp 943 944 945-- | Conditions used by mutation operations ('PutItem', 'UpdateItem', 946-- etc.). The default 'def' instance is empty (no condition). 947data Conditions = Conditions CondMerge [Condition] 948 deriving (Eq,Show,Read,Ord,Typeable) 949 950instance Default Conditions where 951 def = Conditions CondAnd [] 952 953 954 955expectsJson :: Conditions -> [A.Pair] 956expectsJson = conditionsJson "Expected" 957 958 959-- | JSON encoding of conditions parameter in various contexts. 960conditionsJson :: T.Text -> Conditions -> [A.Pair] 961conditionsJson key (Conditions op es) = b ++ a 962 where 963 a = if null es 964 then [] 965 else [key .= object (map conditionJson es)] 966 967 b = if length (take 2 es) > 1 968 then ["ConditionalOperator" .= String (rendCondOp op) ] 969 else [] 970 971 972------------------------------------------------------------------------------- 973rendCondOp :: CondMerge -> T.Text 974rendCondOp CondAnd = "AND" 975rendCondOp CondOr = "OR" 976 977 978------------------------------------------------------------------------------- 979-- | How to merge multiple conditions. 980data CondMerge = CondAnd | CondOr 981 deriving (Eq,Show,Read,Ord,Typeable) 982 983 984-- | A condition used by mutation operations ('PutItem', 'UpdateItem', etc.). 985data Condition = Condition { 986 condAttr :: T.Text 987 -- ^ Attribute to use as the basis for this conditional 988 , condOp :: CondOp 989 -- ^ Operation on the selected attribute 990 } deriving (Eq,Show,Read,Ord,Typeable) 991 992 993------------------------------------------------------------------------------- 994-- | Conditional operation to perform on a field. 995data CondOp 996 = DEq DValue 997 | NotEq DValue 998 | DLE DValue 999 | DLT DValue 1000 | DGE DValue 1001 | DGT DValue 1002 | NotNull 1003 | IsNull 1004 | Contains DValue 1005 | NotContains DValue 1006 | Begins DValue 1007 | In [DValue] 1008 | Between DValue DValue 1009 deriving (Eq,Show,Read,Ord,Typeable) 1010 1011 1012------------------------------------------------------------------------------- 1013getCondValues :: CondOp -> [DValue] 1014getCondValues c = case c of 1015 DEq v -> [v] 1016 NotEq v -> [v] 1017 DLE v -> [v] 1018 DLT v -> [v] 1019 DGE v -> [v] 1020 DGT v -> [v] 1021 NotNull -> [] 1022 IsNull -> [] 1023 Contains v -> [v] 1024 NotContains v -> [v] 1025 Begins v -> [v] 1026 In v -> v 1027 Between a b -> [a,b] 1028 1029 1030------------------------------------------------------------------------------- 1031renderCondOp :: CondOp -> T.Text 1032renderCondOp c = case c of 1033 DEq{} -> "EQ" 1034 NotEq{} -> "NE" 1035 DLE{} -> "LE" 1036 DLT{} -> "LT" 1037 DGE{} -> "GE" 1038 DGT{} -> "GT" 1039 NotNull -> "NOT_NULL" 1040 IsNull -> "NULL" 1041 Contains{} -> "CONTAINS" 1042 NotContains{} -> "NOT_CONTAINS" 1043 Begins{} -> "BEGINS_WITH" 1044 In{} -> "IN" 1045 Between{} -> "BETWEEN" 1046 1047 1048conditionJson :: Condition -> Pair 1049conditionJson Condition{..} = condAttr .= condOp 1050 1051 1052instance ToJSON CondOp where 1053 toJSON c = object $ ("ComparisonOperator" .= String (renderCondOp c)) : valueList 1054 where 1055 valueList = 1056 let vs = getCondValues c in 1057 if null vs 1058 then [] 1059 else ["AttributeValueList" .= vs] 1060 1061------------------------------------------------------------------------------- 1062dyApiVersion :: B.ByteString 1063dyApiVersion = "DynamoDB_20120810." 1064 1065 1066 1067------------------------------------------------------------------------------- 1068-- | The standard response metrics on capacity consumption. 1069data ConsumedCapacity = ConsumedCapacity { 1070 capacityUnits :: Int64 1071 , capacityGlobalIndex :: [(T.Text, Int64)] 1072 , capacityLocalIndex :: [(T.Text, Int64)] 1073 , capacityTableUnits :: Maybe Int64 1074 , capacityTable :: T.Text 1075 } deriving (Eq,Show,Read,Ord,Typeable) 1076 1077 1078instance FromJSON ConsumedCapacity where 1079 parseJSON (Object v) = ConsumedCapacity 1080 <$> v .: "CapacityUnits" 1081 <*> (HM.toList <$> v .:? "GlobalSecondaryIndexes" .!= mempty) 1082 <*> (HM.toList <$> v .:? "LocalSecondaryIndexes" .!= mempty) 1083 <*> (v .:? "Table" >>= maybe (return Nothing) (.: "CapacityUnits")) 1084 <*> v .: "TableName" 1085 parseJSON _ = fail "ConsumedCapacity must be an Object." 1086 1087 1088 1089data ReturnConsumption = RCIndexes | RCTotal | RCNone 1090 deriving (Eq,Show,Read,Ord,Typeable) 1091 1092instance ToJSON ReturnConsumption where 1093 toJSON RCIndexes = String "INDEXES" 1094 toJSON RCTotal = String "TOTAL" 1095 toJSON RCNone = String "NONE" 1096 1097instance Default ReturnConsumption where 1098 def = RCNone 1099 1100data ReturnItemCollectionMetrics = RICMSize | RICMNone 1101 deriving (Eq,Show,Read,Ord,Typeable) 1102 1103instance ToJSON ReturnItemCollectionMetrics where 1104 toJSON RICMSize = String "SIZE" 1105 toJSON RICMNone = String "NONE" 1106 1107instance Default ReturnItemCollectionMetrics where 1108 def = RICMNone 1109 1110 1111data ItemCollectionMetrics = ItemCollectionMetrics { 1112 icmKey :: (T.Text, DValue) 1113 , icmEstimate :: [Double] 1114 } deriving (Eq,Show,Read,Ord,Typeable) 1115 1116 1117instance FromJSON ItemCollectionMetrics where 1118 parseJSON (Object v) = ItemCollectionMetrics 1119 <$> (do m <- v .: "ItemCollectionKey" 1120 return $ head $ HM.toList m) 1121 <*> v .: "SizeEstimateRangeGB" 1122 parseJSON _ = fail "ItemCollectionMetrics must be an Object." 1123 1124 1125------------------------------------------------------------------------------- 1126-- | What to return from the current update operation 1127data UpdateReturn 1128 = URNone -- ^ Return nothing 1129 | URAllOld -- ^ Return old values 1130 | URUpdatedOld -- ^ Return old values with a newer replacement 1131 | URAllNew -- ^ Return new values 1132 | URUpdatedNew -- ^ Return new values that were replacements 1133 deriving (Eq,Show,Read,Ord,Typeable) 1134 1135 1136instance ToJSON UpdateReturn where 1137 toJSON URNone = toJSON (String "NONE") 1138 toJSON URAllOld = toJSON (String "ALL_OLD") 1139 toJSON URUpdatedOld = toJSON (String "UPDATED_OLD") 1140 toJSON URAllNew = toJSON (String "ALL_NEW") 1141 toJSON URUpdatedNew = toJSON (String "UPDATED_NEW") 1142 1143 1144instance Default UpdateReturn where 1145 def = URNone 1146 1147 1148 1149------------------------------------------------------------------------------- 1150-- | What to return from a 'Query' or 'Scan' query. 1151data QuerySelect 1152 = SelectSpecific [T.Text] 1153 -- ^ Only return selected attributes 1154 | SelectCount 1155 -- ^ Return counts instead of attributes 1156 | SelectProjected 1157 -- ^ Return index-projected attributes 1158 | SelectAll 1159 -- ^ Default. Return everything. 1160 deriving (Eq,Show,Read,Ord,Typeable) 1161 1162 1163instance Default QuerySelect where def = SelectAll 1164 1165------------------------------------------------------------------------------- 1166querySelectJson :: KeyValue t => QuerySelect -> [t] 1167querySelectJson (SelectSpecific as) = 1168 [ "Select" .= String "SPECIFIC_ATTRIBUTES" 1169 , "AttributesToGet" .= as] 1170querySelectJson SelectCount = ["Select" .= String "COUNT"] 1171querySelectJson SelectProjected = ["Select" .= String "ALL_PROJECTED_ATTRIBUTES"] 1172querySelectJson SelectAll = ["Select" .= String "ALL_ATTRIBUTES"] 1173 1174 1175------------------------------------------------------------------------------- 1176-- | A class to help predict DynamoDb size of values, attributes and 1177-- entire items. The result is given in number of bytes. 1178class DynSize a where 1179 dynSize :: a -> Int 1180 1181instance DynSize DValue where 1182 dynSize DNull = 8 1183 dynSize (DBool _) = 8 1184 dynSize (DBoolSet s) = sum $ map (dynSize . DBool) $ S.toList s 1185 dynSize (DNum _) = 8 1186 dynSize (DString a) = T.length a 1187 dynSize (DBinary bs) = T.length . T.decodeUtf8 $ Base64.encode bs 1188 dynSize (DNumSet s) = 8 * S.size s 1189 dynSize (DStringSet s) = sum $ map (dynSize . DString) $ S.toList s 1190 dynSize (DBinSet s) = sum $ map (dynSize . DBinary) $ S.toList s 1191 dynSize (DList s) = sum $ map dynSize $ V.toList s 1192 dynSize (DMap s) = sum $ map dynSize $ M.elems s 1193 1194instance DynSize Attribute where 1195 dynSize (Attribute k v) = T.length k + dynSize v 1196 1197instance DynSize Item where 1198 dynSize m = sum $ map dynSize $ attributes m 1199 1200instance DynSize a => DynSize [a] where 1201 dynSize as = sum $ map dynSize as 1202 1203instance DynSize a => DynSize (Maybe a) where 1204 dynSize = maybe 0 dynSize 1205 1206instance (DynSize a, DynSize b) => DynSize (Either a b) where 1207 dynSize = either dynSize dynSize 1208 1209 1210------------------------------------------------------------------------------- 1211-- | Will an attribute be considered empty by DynamoDb? 1212-- 1213-- A 'PutItem' (or similar) with empty attributes will be rejected 1214-- with a 'ValidationException'. 1215nullAttr :: Attribute -> Bool 1216nullAttr (Attribute _ val) = 1217 case val of 1218 DString "" -> True 1219 DBinary "" -> True 1220 DNumSet s | S.null s -> True 1221 DStringSet s | S.null s -> True 1222 DBinSet s | S.null s -> True 1223 _ -> False 1224 1225 1226 1227 1228------------------------------------------------------------------------------- 1229-- 1230-- | Item Parsing 1231-- 1232------------------------------------------------------------------------------- 1233 1234 1235 1236-- | Failure continuation. 1237type Failure f r = String -> f r 1238 1239-- | Success continuation. 1240type Success a f r = a -> f r 1241 1242 1243-- | A continuation-based parser type. 1244newtype Parser a = Parser { 1245 runParser :: forall f r. 1246 Failure f r 1247 -> Success a f r 1248 -> f r 1249 } 1250 1251instance Monad Parser where 1252 m >>= g = Parser $ \kf ks -> let ks' a = runParser (g a) kf ks 1253 in runParser m kf ks' 1254 {-# INLINE (>>=) #-} 1255 return a = Parser $ \_kf ks -> ks a 1256 {-# INLINE return #-} 1257#if !(MIN_VERSION_base(4,13,0)) 1258 fail msg = Parser $ \kf _ks -> kf msg 1259 {-# INLINE fail #-} 1260#endif 1261 1262#if MIN_VERSION_base(4,9,0) 1263instance Fail.MonadFail Parser where 1264 fail msg = Parser $ \kf _ks -> kf msg 1265 {-# INLINE fail #-} 1266#endif 1267 1268instance Functor Parser where 1269 fmap f m = Parser $ \kf ks -> let ks' a = ks (f a) 1270 in runParser m kf ks' 1271 {-# INLINE fmap #-} 1272 1273instance Applicative Parser where 1274 pure = return 1275 {-# INLINE pure #-} 1276 (<*>) = apP 1277 {-# INLINE (<*>) #-} 1278 1279instance Alternative Parser where 1280 empty = fail "empty" 1281 {-# INLINE empty #-} 1282 (<|>) = mplus 1283 {-# INLINE (<|>) #-} 1284 1285instance MonadPlus Parser where 1286 mzero = fail "mzero" 1287 {-# INLINE mzero #-} 1288 mplus a b = Parser $ \kf ks -> let kf' _ = runParser b kf ks 1289 in runParser a kf' ks 1290 {-# INLINE mplus #-} 1291 1292instance Sem.Semigroup (Parser a) where 1293 (<>) = mplus 1294 {-# INLINE (<>) #-} 1295 1296instance Monoid (Parser a) where 1297 mempty = fail "mempty" 1298 {-# INLINE mempty #-} 1299 mappend = (Sem.<>) 1300 {-# INLINE mappend #-} 1301 1302apP :: Parser (a -> b) -> Parser a -> Parser b 1303apP d e = do 1304 b <- d 1305 a <- e 1306 return (b a) 1307{-# INLINE apP #-} 1308 1309 1310------------------------------------------------------------------------------- 1311-- | Types convertible to DynamoDb 'Item' collections. 1312-- 1313-- Use 'attr' and 'attrAs' combinators to conveniently define instances. 1314class ToDynItem a where 1315 toItem :: a -> Item 1316 1317 1318------------------------------------------------------------------------------- 1319-- | Types parseable from DynamoDb 'Item' collections. 1320-- 1321-- User 'getAttr' family of functions to applicatively or monadically 1322-- parse into your custom types. 1323class FromDynItem a where 1324 parseItem :: Item -> Parser a 1325 1326 1327instance ToDynItem Item where toItem = id 1328 1329instance FromDynItem Item where parseItem = return 1330 1331 1332instance DynVal a => ToDynItem [(T.Text, a)] where 1333 toItem as = item $ map (uncurry attr) as 1334 1335instance (Typeable a, DynVal a) => FromDynItem [(T.Text, a)] where 1336 parseItem i = mapM f $ M.toList i 1337 where 1338 f (k,v) = do 1339 v' <- maybe (fail (valErr (Tagged v :: Tagged a DValue))) return $ 1340 fromValue v 1341 return (k, v') 1342 1343 1344instance DynVal a => ToDynItem (M.Map T.Text a) where 1345 toItem m = toItem $ M.toList m 1346 1347 1348instance (Typeable a, DynVal a) => FromDynItem (M.Map T.Text a) where 1349 parseItem i = M.fromList <$> parseItem i 1350 1351 1352valErr :: forall a. Typeable a => Tagged a DValue -> String 1353valErr (Tagged dv) = "Can't convert DynamoDb value " Sem.<> show dv Sem.<> 1354 " into type " Sem.<> (show (typeOf (undefined :: a))) 1355 1356 1357-- | Convenience combinator for parsing fields from an 'Item' returned 1358-- by DynamoDb. 1359getAttr 1360 :: forall a. (Typeable a, DynVal a) 1361 => T.Text 1362 -- ^ Attribute name 1363 -> Item 1364 -- ^ Item from DynamoDb 1365 -> Parser a 1366getAttr k m = do 1367 case M.lookup k m of 1368 Nothing -> fail ("Key " Sem.<> T.unpack k Sem.<> " not found") 1369 Just dv -> maybe (fail (valErr (Tagged dv :: Tagged a DValue))) return $ fromValue dv 1370 1371 1372-- | Parse attribute if it's present in the 'Item'. Fail if attribute 1373-- is present but conversion fails. 1374getAttr' 1375 :: forall a. (DynVal a) 1376 => T.Text 1377 -- ^ Attribute name 1378 -> Item 1379 -- ^ Item from DynamoDb 1380 -> Parser (Maybe a) 1381getAttr' k m = do 1382 case M.lookup k m of 1383 Nothing -> return Nothing 1384 Just dv -> return $ fromValue dv 1385 1386-- | Combinator for parsing an attribute into a 'FromDynItem'. 1387parseAttr 1388 :: FromDynItem a 1389 => T.Text 1390 -- ^ Attribute name 1391 -> Item 1392 -- ^ Item from DynamoDb 1393 -> Parser a 1394parseAttr k m = 1395 case M.lookup k m of 1396 Nothing -> fail ("Key " Sem.<> T.unpack k Sem.<> " not found") 1397 Just (DMap dv) -> either (const (fail "...")) return $ fromItem dv 1398 _ -> fail ("Key " Sem.<> T.unpack k Sem.<> " is not a map!") 1399 1400------------------------------------------------------------------------------- 1401-- | Parse an 'Item' into target type using the 'FromDynItem' 1402-- instance. 1403fromItem :: FromDynItem a => Item -> Either String a 1404fromItem i = runParser (parseItem i) Left Right 1405