{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NoMonomorphismRestriction  #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Aws.DynamoDb.Core
-- Copyright   :  Soostone Inc, Chris Allen
-- License     :  BSD3
--
-- Maintainer  :  Ozgun Ataman <ozgun.ataman@soostone.com>
-- Stability   :  experimental
--
-- Shared types and utilities for DyanmoDb functionality.
----------------------------------------------------------------------------

module Aws.DynamoDb.Core
    (
    -- * Configuration and Regions
      Region (..)
    , ddbLocal
    , ddbUsEast1
    , ddbUsWest1
    , ddbUsWest2
    , ddbEuWest1
    , ddbEuWest2
    , ddbEuCentral1
    , ddbApNe1
    , ddbApSe1
    , ddbApSe2
    , ddbSaEast1
    , DdbConfiguration (..)

    -- * DynamoDB values
    , DValue (..)

    -- * Converting to/from 'DValue'
    , DynVal(..)
    , toValue, fromValue
    , Bin (..)
    , OldBool(..)

    -- * Defining new 'DynVal' instances
    , DynData(..)
    , DynBinary(..), DynNumber(..), DynString(..), DynBool(..)

    -- * Working with key/value pairs
    , Attribute (..)
    , parseAttributeJson
    , attributeJson
    , attributesJson

    , attrTuple
    , attr
    , attrAs
    , text, int, double
    , PrimaryKey (..)
    , hk
    , hrk

    -- * Working with objects (attribute collections)
    , Item
    , item
    , attributes
    , ToDynItem (..)
    , FromDynItem (..)
    , fromItem
    , Parser (..)
    , getAttr
    , getAttr'
    , parseAttr

    -- * Common types used by operations
    , Conditions (..)
    , conditionsJson
    , expectsJson

    , Condition (..)
    , conditionJson
    , CondOp (..)
    , CondMerge (..)
    , ConsumedCapacity (..)
    , ReturnConsumption (..)
    , ItemCollectionMetrics (..)
    , ReturnItemCollectionMetrics (..)
    , UpdateReturn (..)
    , QuerySelect (..)
    , querySelectJson

    -- * Size estimation
    , DynSize (..)
    , nullAttr

    -- * Responses & Errors
    , DdbResponse (..)
    , DdbErrCode (..)
    , shouldRetry
    , DdbError (..)

    -- * Internal Helpers
    , ddbSignQuery
    , AmazonError (..)
    , ddbResponseConsumer
    , ddbHttp
    , ddbHttps

    ) where


-------------------------------------------------------------------------------
import           Control.Applicative
import qualified Control.Exception            as C
import           Control.Monad
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail           as Fail
#endif
import           Control.Monad.Trans
import           Control.Monad.Trans.Resource (throwM)
import qualified Crypto.Hash                  as CH
import           Data.Aeson
import qualified Data.Aeson                   as A
import qualified Data.Aeson.Key               as AK
import qualified Data.Aeson.KeyMap            as KM
import           Data.Aeson.Types             (Pair, parseEither)
import qualified Data.Aeson.Types             as A
import qualified Data.Attoparsec.ByteString   as AttoB (endOfInput)
import qualified Data.Attoparsec.Text         as Atto
import qualified Data.ByteArray               as ByteArray
import qualified Data.ByteString.Base16       as Base16
import qualified Data.ByteString.Base64       as Base64
import qualified Data.ByteString.Char8        as B
import qualified Data.CaseInsensitive         as CI
import           Data.Conduit
import           Data.Conduit.Attoparsec      (sinkParser)
import           Data.Default
import           Data.Function                (on)
import           Data.Int
import           Data.IORef
import           Data.List
import qualified Data.Map                     as M
import           Data.Maybe
import           Data.Monoid                  ()
import qualified Data.Semigroup               as Sem
import           Data.Proxy
import           Data.Scientific
import qualified Data.Serialize               as Ser
import qualified Data.Set                     as S
import           Data.String
import           Data.Tagged
import qualified Data.Text                    as T
import qualified Data.Text.Encoding           as T
import           Data.Time
import           Data.Typeable
import qualified Data.Vector                  as V
import           Data.Word
import qualified Network.HTTP.Conduit         as HTTP
import qualified Network.HTTP.Types           as HTTP
import           Safe
-------------------------------------------------------------------------------
import           Aws.Core
-------------------------------------------------------------------------------

-------------------------------------------------------------------------------
-- | Boolean values stored in DynamoDb. Only used in defining new
-- 'DynVal' instances.
newtype DynBool = DynBool { DynBool -> Bool
unDynBool :: Bool }
    deriving (DynBool -> DynBool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DynBool -> DynBool -> Bool
$c/= :: DynBool -> DynBool -> Bool
== :: DynBool -> DynBool -> Bool
$c== :: DynBool -> DynBool -> Bool
Eq,Int -> DynBool -> ShowS
[DynBool] -> ShowS
DynBool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DynBool] -> ShowS
$cshowList :: [DynBool] -> ShowS
show :: DynBool -> String
$cshow :: DynBool -> String
showsPrec :: Int -> DynBool -> ShowS
$cshowsPrec :: Int -> DynBool -> ShowS
Show,ReadPrec [DynBool]
ReadPrec DynBool
Int -> ReadS DynBool
ReadS [DynBool]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DynBool]
$creadListPrec :: ReadPrec [DynBool]
readPrec :: ReadPrec DynBool
$creadPrec :: ReadPrec DynBool
readList :: ReadS [DynBool]
$creadList :: ReadS [DynBool]
readsPrec :: Int -> ReadS DynBool
$creadsPrec :: Int -> ReadS DynBool
Read,Eq DynBool
DynBool -> DynBool -> Bool
DynBool -> DynBool -> Ordering
DynBool -> DynBool -> DynBool
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DynBool -> DynBool -> DynBool
$cmin :: DynBool -> DynBool -> DynBool
max :: DynBool -> DynBool -> DynBool
$cmax :: DynBool -> DynBool -> DynBool
>= :: DynBool -> DynBool -> Bool
$c>= :: DynBool -> DynBool -> Bool
> :: DynBool -> DynBool -> Bool
$c> :: DynBool -> DynBool -> Bool
<= :: DynBool -> DynBool -> Bool
$c<= :: DynBool -> DynBool -> Bool
< :: DynBool -> DynBool -> Bool
$c< :: DynBool -> DynBool -> Bool
compare :: DynBool -> DynBool -> Ordering
$ccompare :: DynBool -> DynBool -> Ordering
Ord,Typeable)


-------------------------------------------------------------------------------
-- | Numeric values stored in DynamoDb. Only used in defining new
-- 'DynVal' instances.
newtype DynNumber = DynNumber { DynNumber -> Scientific
unDynNumber :: Scientific }
    deriving (DynNumber -> DynNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DynNumber -> DynNumber -> Bool
$c/= :: DynNumber -> DynNumber -> Bool
== :: DynNumber -> DynNumber -> Bool
$c== :: DynNumber -> DynNumber -> Bool
Eq,Int -> DynNumber -> ShowS
[DynNumber] -> ShowS
DynNumber -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DynNumber] -> ShowS
$cshowList :: [DynNumber] -> ShowS
show :: DynNumber -> String
$cshow :: DynNumber -> String
showsPrec :: Int -> DynNumber -> ShowS
$cshowsPrec :: Int -> DynNumber -> ShowS
Show,ReadPrec [DynNumber]
ReadPrec DynNumber
Int -> ReadS DynNumber
ReadS [DynNumber]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DynNumber]
$creadListPrec :: ReadPrec [DynNumber]
readPrec :: ReadPrec DynNumber
$creadPrec :: ReadPrec DynNumber
readList :: ReadS [DynNumber]
$creadList :: ReadS [DynNumber]
readsPrec :: Int -> ReadS DynNumber
$creadsPrec :: Int -> ReadS DynNumber
Read,Eq DynNumber
DynNumber -> DynNumber -> Bool
DynNumber -> DynNumber -> Ordering
DynNumber -> DynNumber -> DynNumber
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DynNumber -> DynNumber -> DynNumber
$cmin :: DynNumber -> DynNumber -> DynNumber
max :: DynNumber -> DynNumber -> DynNumber
$cmax :: DynNumber -> DynNumber -> DynNumber
>= :: DynNumber -> DynNumber -> Bool
$c>= :: DynNumber -> DynNumber -> Bool
> :: DynNumber -> DynNumber -> Bool
$c> :: DynNumber -> DynNumber -> Bool
<= :: DynNumber -> DynNumber -> Bool
$c<= :: DynNumber -> DynNumber -> Bool
< :: DynNumber -> DynNumber -> Bool
$c< :: DynNumber -> DynNumber -> Bool
compare :: DynNumber -> DynNumber -> Ordering
$ccompare :: DynNumber -> DynNumber -> Ordering
Ord,Typeable)


-------------------------------------------------------------------------------
-- | String values stored in DynamoDb. Only used in defining new
-- 'DynVal' instances.
newtype DynString = DynString { DynString -> Text
unDynString :: T.Text }
    deriving (DynString -> DynString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DynString -> DynString -> Bool
$c/= :: DynString -> DynString -> Bool
== :: DynString -> DynString -> Bool
$c== :: DynString -> DynString -> Bool
Eq,Int -> DynString -> ShowS
[DynString] -> ShowS
DynString -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DynString] -> ShowS
$cshowList :: [DynString] -> ShowS
show :: DynString -> String
$cshow :: DynString -> String
showsPrec :: Int -> DynString -> ShowS
$cshowsPrec :: Int -> DynString -> ShowS
Show,ReadPrec [DynString]
ReadPrec DynString
Int -> ReadS DynString
ReadS [DynString]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DynString]
$creadListPrec :: ReadPrec [DynString]
readPrec :: ReadPrec DynString
$creadPrec :: ReadPrec DynString
readList :: ReadS [DynString]
$creadList :: ReadS [DynString]
readsPrec :: Int -> ReadS DynString
$creadsPrec :: Int -> ReadS DynString
Read,Eq DynString
DynString -> DynString -> Bool
DynString -> DynString -> Ordering
DynString -> DynString -> DynString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DynString -> DynString -> DynString
$cmin :: DynString -> DynString -> DynString
max :: DynString -> DynString -> DynString
$cmax :: DynString -> DynString -> DynString
>= :: DynString -> DynString -> Bool
$c>= :: DynString -> DynString -> Bool
> :: DynString -> DynString -> Bool
$c> :: DynString -> DynString -> Bool
<= :: DynString -> DynString -> Bool
$c<= :: DynString -> DynString -> Bool
< :: DynString -> DynString -> Bool
$c< :: DynString -> DynString -> Bool
compare :: DynString -> DynString -> Ordering
$ccompare :: DynString -> DynString -> Ordering
Ord,Typeable)


-------------------------------------------------------------------------------
-- | Binary values stored in DynamoDb. Only used in defining new
-- 'DynVal' instances.
newtype DynBinary = DynBinary { DynBinary -> ByteString
unDynBinary :: B.ByteString }
    deriving (DynBinary -> DynBinary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DynBinary -> DynBinary -> Bool
$c/= :: DynBinary -> DynBinary -> Bool
== :: DynBinary -> DynBinary -> Bool
$c== :: DynBinary -> DynBinary -> Bool
Eq,Int -> DynBinary -> ShowS
[DynBinary] -> ShowS
DynBinary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DynBinary] -> ShowS
$cshowList :: [DynBinary] -> ShowS
show :: DynBinary -> String
$cshow :: DynBinary -> String
showsPrec :: Int -> DynBinary -> ShowS
$cshowsPrec :: Int -> DynBinary -> ShowS
Show,ReadPrec [DynBinary]
ReadPrec DynBinary
Int -> ReadS DynBinary
ReadS [DynBinary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DynBinary]
$creadListPrec :: ReadPrec [DynBinary]
readPrec :: ReadPrec DynBinary
$creadPrec :: ReadPrec DynBinary
readList :: ReadS [DynBinary]
$creadList :: ReadS [DynBinary]
readsPrec :: Int -> ReadS DynBinary
$creadsPrec :: Int -> ReadS DynBinary
Read,Eq DynBinary
DynBinary -> DynBinary -> Bool
DynBinary -> DynBinary -> Ordering
DynBinary -> DynBinary -> DynBinary
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DynBinary -> DynBinary -> DynBinary
$cmin :: DynBinary -> DynBinary -> DynBinary
max :: DynBinary -> DynBinary -> DynBinary
$cmax :: DynBinary -> DynBinary -> DynBinary
>= :: DynBinary -> DynBinary -> Bool
$c>= :: DynBinary -> DynBinary -> Bool
> :: DynBinary -> DynBinary -> Bool
$c> :: DynBinary -> DynBinary -> Bool
<= :: DynBinary -> DynBinary -> Bool
$c<= :: DynBinary -> DynBinary -> Bool
< :: DynBinary -> DynBinary -> Bool
$c< :: DynBinary -> DynBinary -> Bool
compare :: DynBinary -> DynBinary -> Ordering
$ccompare :: DynBinary -> DynBinary -> Ordering
Ord,Typeable)


-------------------------------------------------------------------------------
-- | An internally used closed typeclass for values that have direct
-- DynamoDb representations. Based on AWS API, this is basically
-- numbers, strings and binary blobs.
--
-- This is here so that any 'DynVal' haskell value can automatically
-- be lifted to a list or a 'Set' without any instance code
-- duplication.
--
-- Do not try to create your own instances.
class Ord a => DynData a where
    fromData :: a -> DValue
    toData :: DValue -> Maybe a

instance DynData DynBool where
    fromData :: DynBool -> DValue
fromData (DynBool Bool
i) = Bool -> DValue
DBool Bool
i
    toData :: DValue -> Maybe DynBool
toData (DBool Bool
i) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bool -> DynBool
DynBool Bool
i
    toData (DNum Scientific
i) = Bool -> DynBool
DynBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` do
        (Int
i' :: Int) <- forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral Scientific
i
        case Int
i' of
          Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          Int
_ -> forall a. Maybe a
Nothing
    toData DValue
_ = forall a. Maybe a
Nothing

instance DynData (S.Set DynBool) where
    fromData :: Set DynBool -> DValue
fromData Set DynBool
set = Set Bool -> DValue
DBoolSet (forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map DynBool -> Bool
unDynBool Set DynBool
set)
    toData :: DValue -> Maybe (Set DynBool)
toData (DBoolSet Set Bool
i) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Bool -> DynBool
DynBool Set Bool
i
    toData DValue
_ = forall a. Maybe a
Nothing

instance DynData DynNumber where
    fromData :: DynNumber -> DValue
fromData (DynNumber Scientific
i) = Scientific -> DValue
DNum Scientific
i
    toData :: DValue -> Maybe DynNumber
toData (DNum Scientific
i) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Scientific -> DynNumber
DynNumber Scientific
i
    toData DValue
_ = forall a. Maybe a
Nothing

instance DynData (S.Set DynNumber) where
    fromData :: Set DynNumber -> DValue
fromData Set DynNumber
set = Set Scientific -> DValue
DNumSet (forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map DynNumber -> Scientific
unDynNumber Set DynNumber
set)
    toData :: DValue -> Maybe (Set DynNumber)
toData (DNumSet Set Scientific
i) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Scientific -> DynNumber
DynNumber Set Scientific
i
    toData DValue
_ = forall a. Maybe a
Nothing

instance DynData DynString where
    fromData :: DynString -> DValue
fromData (DynString Text
i) = Text -> DValue
DString Text
i
    toData :: DValue -> Maybe DynString
toData (DString Text
i) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> DynString
DynString Text
i
    toData DValue
_ = forall a. Maybe a
Nothing

instance DynData (S.Set DynString) where
    fromData :: Set DynString -> DValue
fromData Set DynString
set = Set Text -> DValue
DStringSet (forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map DynString -> Text
unDynString Set DynString
set)
    toData :: DValue -> Maybe (Set DynString)
toData (DStringSet Set Text
i) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Text -> DynString
DynString Set Text
i
    toData DValue
_ = forall a. Maybe a
Nothing

instance DynData DynBinary where
    fromData :: DynBinary -> DValue
fromData (DynBinary ByteString
i) = ByteString -> DValue
DBinary ByteString
i
    toData :: DValue -> Maybe DynBinary
toData (DBinary ByteString
i) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> DynBinary
DynBinary ByteString
i
    toData DValue
_ = forall a. Maybe a
Nothing

instance DynData (S.Set DynBinary) where
    fromData :: Set DynBinary -> DValue
fromData Set DynBinary
set = Set ByteString -> DValue
DBinSet (forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map DynBinary -> ByteString
unDynBinary Set DynBinary
set)
    toData :: DValue -> Maybe (Set DynBinary)
toData (DBinSet Set ByteString
i) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map ByteString -> DynBinary
DynBinary Set ByteString
i
    toData DValue
_ = forall a. Maybe a
Nothing

instance DynData DValue where
    fromData :: DValue -> DValue
fromData = forall a. a -> a
id
    toData :: DValue -> Maybe DValue
toData = forall a. a -> Maybe a
Just


-------------------------------------------------------------------------------
-- | Class of Haskell types that can be represented as DynamoDb values.
--
-- This is the conversion layer; instantiate this class for your own
-- types and then use the 'toValue' and 'fromValue' combinators to
-- convert in application code.
--
-- Each Haskell type instantiated with this class will map to a
-- DynamoDb-supported type that most naturally represents it.
class DynData (DynRep a) => DynVal a where

    -- | Which of the 'DynData' instances does this data type directly
    -- map to?
    type DynRep a

    -- | Convert to representation
    toRep :: a -> DynRep a

    -- | Convert from representation
    fromRep :: DynRep a -> Maybe a


-------------------------------------------------------------------------------
-- | Any singular 'DynVal' can be upgraded to a list.
instance (DynData (DynRep [a]), DynVal a) => DynVal [a] where
    type DynRep [a] = S.Set (DynRep a)
    fromRep :: DynRep [a] -> Maybe [a]
fromRep DynRep [a]
set = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. DynVal a => DynRep a -> Maybe a
fromRep forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList DynRep [a]
set
    toRep :: [a] -> DynRep [a]
toRep [a]
as = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. DynVal a => a -> DynRep a
toRep [a]
as


-------------------------------------------------------------------------------
-- | Any singular 'DynVal' can be upgraded to a 'Set'.
instance (DynData (DynRep (S.Set a)), DynVal a, Ord a) => DynVal (S.Set a) where
    type DynRep (S.Set a) = S.Set (DynRep a)
    fromRep :: DynRep (Set a) -> Maybe (Set a)
fromRep DynRep (Set a)
set = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. DynVal a => DynRep a -> Maybe a
fromRep forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList DynRep (Set a)
set
    toRep :: Set a -> DynRep (Set a)
toRep Set a
as = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map forall a. DynVal a => a -> DynRep a
toRep Set a
as


instance DynVal DValue where
    type DynRep DValue = DValue
    fromRep :: DynRep DValue -> Maybe DValue
fromRep = forall a. a -> Maybe a
Just
    toRep :: DValue -> DynRep DValue
toRep   = forall a. a -> a
id

instance DynVal Bool where
    type DynRep Bool = DynBool
    fromRep :: DynRep Bool -> Maybe Bool
fromRep (DynBool Bool
i) = forall a. a -> Maybe a
Just Bool
i
    toRep :: Bool -> DynRep Bool
toRep Bool
i = Bool -> DynBool
DynBool Bool
i

instance DynVal Int where
    type DynRep Int = DynNumber
    fromRep :: DynRep Int -> Maybe Int
fromRep (DynNumber Scientific
i) = forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral Scientific
i
    toRep :: Int -> DynRep Int
toRep Int
i = Scientific -> DynNumber
DynNumber (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)


instance DynVal Int8 where
    type DynRep Int8 = DynNumber
    fromRep :: DynRep Int8 -> Maybe Int8
fromRep (DynNumber Scientific
i) = forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral Scientific
i
    toRep :: Int8 -> DynRep Int8
toRep Int8
i = Scientific -> DynNumber
DynNumber (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
i)


instance DynVal Int16 where
    type DynRep Int16 = DynNumber
    fromRep :: DynRep Int16 -> Maybe Int16
fromRep (DynNumber Scientific
i) = forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral Scientific
i
    toRep :: Int16 -> DynRep Int16
toRep Int16
i = Scientific -> DynNumber
DynNumber (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
i)


instance DynVal Int32 where
    type DynRep Int32 = DynNumber
    fromRep :: DynRep Int32 -> Maybe Int32
fromRep (DynNumber Scientific
i) = forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral Scientific
i
    toRep :: Int32 -> DynRep Int32
toRep Int32
i = Scientific -> DynNumber
DynNumber (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)


instance DynVal Int64 where
    type DynRep Int64 = DynNumber
    fromRep :: DynRep Int64 -> Maybe Int64
fromRep (DynNumber Scientific
i) = forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral Scientific
i
    toRep :: Int64 -> DynRep Int64
toRep Int64
i = Scientific -> DynNumber
DynNumber (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)


instance DynVal Word8 where
    type DynRep Word8 = DynNumber
    fromRep :: DynRep Word8 -> Maybe Word8
fromRep (DynNumber Scientific
i) = forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral Scientific
i
    toRep :: Word8 -> DynRep Word8
toRep Word8
i = Scientific -> DynNumber
DynNumber (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)


instance DynVal Word16 where
    type DynRep Word16 = DynNumber
    fromRep :: DynRep Word16 -> Maybe Word16
fromRep (DynNumber Scientific
i) = forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral Scientific
i
    toRep :: Word16 -> DynRep Word16
toRep Word16
i = Scientific -> DynNumber
DynNumber (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
i)


instance DynVal Word32 where
    type DynRep Word32 = DynNumber
    fromRep :: DynRep Word32 -> Maybe Word32
fromRep (DynNumber Scientific
i) = forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral Scientific
i
    toRep :: Word32 -> DynRep Word32
toRep Word32
i = Scientific -> DynNumber
DynNumber (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i)


instance DynVal Word64 where
    type DynRep Word64 = DynNumber
    fromRep :: DynRep Word64 -> Maybe Word64
fromRep (DynNumber Scientific
i) = forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral Scientific
i
    toRep :: Word64 -> DynRep Word64
toRep Word64
i = Scientific -> DynNumber
DynNumber (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i)


instance DynVal Integer where
    type DynRep Integer = DynNumber
    fromRep :: DynRep Integer -> Maybe Integer
fromRep (DynNumber Scientific
i) = forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral Scientific
i
    toRep :: Integer -> DynRep Integer
toRep Integer
i = Scientific -> DynNumber
DynNumber (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)


instance DynVal T.Text where
    type DynRep T.Text = DynString
    fromRep :: DynRep Text -> Maybe Text
fromRep (DynString Text
i) = forall a. a -> Maybe a
Just Text
i
    toRep :: Text -> DynRep Text
toRep Text
i = Text -> DynString
DynString Text
i


instance DynVal B.ByteString where
    type DynRep B.ByteString = DynBinary
    fromRep :: DynRep ByteString -> Maybe ByteString
fromRep (DynBinary ByteString
i) = forall a. a -> Maybe a
Just ByteString
i
    toRep :: ByteString -> DynRep ByteString
toRep ByteString
i = ByteString -> DynBinary
DynBinary ByteString
i


instance DynVal Double where
    type DynRep Double = DynNumber
    fromRep :: DynRep Double -> Maybe Double
fromRep (DynNumber Scientific
i) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
i
    toRep :: Double -> DynRep Double
toRep Double
i = Scientific -> DynNumber
DynNumber (forall a. RealFloat a => a -> Scientific
fromFloatDigits Double
i)


-------------------------------------------------------------------------------
-- | Encoded as number of days
instance DynVal Day where
    type DynRep Day = DynNumber
    fromRep :: DynRep Day -> Maybe Day
fromRep (DynNumber Scientific
i) = Integer -> Day
ModifiedJulianDay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral Scientific
i)
    toRep :: Day -> DynRep Day
toRep (ModifiedJulianDay Integer
i) = Scientific -> DynNumber
DynNumber (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)


-------------------------------------------------------------------------------
-- | Losslessly encoded via 'Integer' picoseconds
instance DynVal UTCTime where
    type DynRep UTCTime = DynNumber
    fromRep :: DynRep UTCTime -> Maybe UTCTime
fromRep DynRep UTCTime
num = Integer -> UTCTime
fromTS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. DynVal a => DynRep a -> Maybe a
fromRep DynRep UTCTime
num
    toRep :: UTCTime -> DynRep UTCTime
toRep UTCTime
x = forall a. DynVal a => a -> DynRep a
toRep (UTCTime -> Integer
toTS UTCTime
x)


-------------------------------------------------------------------------------
pico :: Rational
pico :: Rational
pico = forall a. Real a => a -> Rational
toRational forall a b. (a -> b) -> a -> b
$ (Integer
10 :: Integer) forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
12 :: Integer)


-------------------------------------------------------------------------------
dayPico :: Integer
dayPico :: Integer
dayPico = Integer
86400 forall a. Num a => a -> a -> a
* forall a b. (RealFrac a, Integral b) => a -> b
round Rational
pico


-------------------------------------------------------------------------------
-- | Convert UTCTime to picoseconds
--
-- TODO: Optimize performance?
toTS :: UTCTime -> Integer
toTS :: UTCTime -> Integer
toTS (UTCTime (ModifiedJulianDay Integer
i) DiffTime
diff) = Integer
i' forall a. Num a => a -> a -> a
+ Integer
diff'
    where
      diff' :: Integer
diff' = forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a. Real a => a -> Rational
toRational DiffTime
diff forall a. Num a => a -> a -> a
* Rational
pico)
      i' :: Integer
i' = Integer
i forall a. Num a => a -> a -> a
* Integer
dayPico


-------------------------------------------------------------------------------
-- | Convert picoseconds to UTCTime
--
-- TODO: Optimize performance?
fromTS :: Integer -> UTCTime
fromTS :: Integer -> UTCTime
fromTS Integer
i = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day
ModifiedJulianDay Integer
days) DiffTime
diff
    where
      (Integer
days, Integer
secs) = Integer
i forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
dayPico
      diff :: DiffTime
diff = forall a. Fractional a => Rational -> a
fromRational ((forall a. Real a => a -> Rational
toRational Integer
secs) forall a. Fractional a => a -> a -> a
/ Rational
pico)



-- | Type wrapper for binary data to be written to DynamoDB. Wrap any
-- 'Serialize' instance in there and 'DynVal' will know how to
-- automatically handle conversions in binary form.
newtype Bin a = Bin { forall a. Bin a -> a
getBin :: a }
    deriving (Bin a -> Bin a -> Bool
forall a. Eq a => Bin a -> Bin a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bin a -> Bin a -> Bool
$c/= :: forall a. Eq a => Bin a -> Bin a -> Bool
== :: Bin a -> Bin a -> Bool
$c== :: forall a. Eq a => Bin a -> Bin a -> Bool
Eq,Int -> Bin a -> ShowS
forall a. Show a => Int -> Bin a -> ShowS
forall a. Show a => [Bin a] -> ShowS
forall a. Show a => Bin a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bin a] -> ShowS
$cshowList :: forall a. Show a => [Bin a] -> ShowS
show :: Bin a -> String
$cshow :: forall a. Show a => Bin a -> String
showsPrec :: Int -> Bin a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Bin a -> ShowS
Show,ReadPrec [Bin a]
ReadPrec (Bin a)
ReadS [Bin a]
forall a. Read a => ReadPrec [Bin a]
forall a. Read a => ReadPrec (Bin a)
forall a. Read a => Int -> ReadS (Bin a)
forall a. Read a => ReadS [Bin a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Bin a]
$creadListPrec :: forall a. Read a => ReadPrec [Bin a]
readPrec :: ReadPrec (Bin a)
$creadPrec :: forall a. Read a => ReadPrec (Bin a)
readList :: ReadS [Bin a]
$creadList :: forall a. Read a => ReadS [Bin a]
readsPrec :: Int -> ReadS (Bin a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Bin a)
Read,Bin a -> Bin a -> Bool
Bin a -> Bin a -> Ordering
Bin a -> Bin a -> Bin a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Bin a)
forall a. Ord a => Bin a -> Bin a -> Bool
forall a. Ord a => Bin a -> Bin a -> Ordering
forall a. Ord a => Bin a -> Bin a -> Bin a
min :: Bin a -> Bin a -> Bin a
$cmin :: forall a. Ord a => Bin a -> Bin a -> Bin a
max :: Bin a -> Bin a -> Bin a
$cmax :: forall a. Ord a => Bin a -> Bin a -> Bin a
>= :: Bin a -> Bin a -> Bool
$c>= :: forall a. Ord a => Bin a -> Bin a -> Bool
> :: Bin a -> Bin a -> Bool
$c> :: forall a. Ord a => Bin a -> Bin a -> Bool
<= :: Bin a -> Bin a -> Bool
$c<= :: forall a. Ord a => Bin a -> Bin a -> Bool
< :: Bin a -> Bin a -> Bool
$c< :: forall a. Ord a => Bin a -> Bin a -> Bool
compare :: Bin a -> Bin a -> Ordering
$ccompare :: forall a. Ord a => Bin a -> Bin a -> Ordering
Ord,Typeable,Int -> Bin a
Bin a -> Int
Bin a -> [Bin a]
Bin a -> Bin a
Bin a -> Bin a -> [Bin a]
Bin a -> Bin a -> Bin a -> [Bin a]
forall a. Enum a => Int -> Bin a
forall a. Enum a => Bin a -> Int
forall a. Enum a => Bin a -> [Bin a]
forall a. Enum a => Bin a -> Bin a
forall a. Enum a => Bin a -> Bin a -> [Bin a]
forall a. Enum a => Bin a -> Bin a -> Bin a -> [Bin a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Bin a -> Bin a -> Bin a -> [Bin a]
$cenumFromThenTo :: forall a. Enum a => Bin a -> Bin a -> Bin a -> [Bin a]
enumFromTo :: Bin a -> Bin a -> [Bin a]
$cenumFromTo :: forall a. Enum a => Bin a -> Bin a -> [Bin a]
enumFromThen :: Bin a -> Bin a -> [Bin a]
$cenumFromThen :: forall a. Enum a => Bin a -> Bin a -> [Bin a]
enumFrom :: Bin a -> [Bin a]
$cenumFrom :: forall a. Enum a => Bin a -> [Bin a]
fromEnum :: Bin a -> Int
$cfromEnum :: forall a. Enum a => Bin a -> Int
toEnum :: Int -> Bin a
$ctoEnum :: forall a. Enum a => Int -> Bin a
pred :: Bin a -> Bin a
$cpred :: forall a. Enum a => Bin a -> Bin a
succ :: Bin a -> Bin a
$csucc :: forall a. Enum a => Bin a -> Bin a
Enum)


instance (Ser.Serialize a) => DynVal (Bin a) where
    type DynRep (Bin a) = DynBinary
    toRep :: Bin a -> DynRep (Bin a)
toRep (Bin a
i) = ByteString -> DynBinary
DynBinary (forall a. Serialize a => a -> ByteString
Ser.encode a
i)
    fromRep :: DynRep (Bin a) -> Maybe (Bin a)
fromRep (DynBinary ByteString
i) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Bin a
Bin) forall a b. (a -> b) -> a -> b
$
                            forall a. Serialize a => ByteString -> Either String a
Ser.decode ByteString
i

newtype OldBool = OldBool Bool

instance DynVal OldBool where
    type DynRep OldBool = DynNumber
    fromRep :: DynRep OldBool -> Maybe OldBool
fromRep (DynNumber Scientific
i) = Bool -> OldBool
OldBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` do
        (Int
i' :: Int) <- forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral Scientific
i
        case Int
i' of
          Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          Int
_ -> forall a. Maybe a
Nothing
    toRep :: OldBool -> DynRep OldBool
toRep (OldBool Bool
b) = Scientific -> DynNumber
DynNumber (if Bool
b then Scientific
1 else Scientific
0)


-------------------------------------------------------------------------------
-- | Encode a Haskell value.
toValue :: DynVal a  => a -> DValue
toValue :: forall a. DynVal a => a -> DValue
toValue a
a = forall a. DynData a => a -> DValue
fromData forall a b. (a -> b) -> a -> b
$ forall a. DynVal a => a -> DynRep a
toRep a
a


-------------------------------------------------------------------------------
-- | Decode a Haskell value.
fromValue :: DynVal a => DValue -> Maybe a
fromValue :: forall a. DynVal a => DValue -> Maybe a
fromValue DValue
d = forall a. DynData a => DValue -> Maybe a
toData DValue
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. DynVal a => DynRep a -> Maybe a
fromRep


toIntegral :: (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral :: forall a a1. (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral a1
sc = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
floor a1
sc



-- | Value types natively recognized by DynamoDb. We pretty much
-- exactly reflect the AWS API onto Haskell types.
data DValue
    = DNull
    | DNum Scientific
    | DString T.Text
    | DBinary B.ByteString
    -- ^ Binary data will automatically be base64 marshalled.
    | DNumSet (S.Set Scientific)
    | DStringSet (S.Set T.Text)
    | DBinSet (S.Set B.ByteString)
    -- ^ Binary data will automatically be base64 marshalled.
    | DBool Bool
    | DBoolSet (S.Set Bool)
    -- ^ Composite data
    | DList (V.Vector DValue)
    | DMap (M.Map T.Text DValue)
    deriving (DValue -> DValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DValue -> DValue -> Bool
$c/= :: DValue -> DValue -> Bool
== :: DValue -> DValue -> Bool
$c== :: DValue -> DValue -> Bool
Eq,Int -> DValue -> ShowS
[DValue] -> ShowS
DValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DValue] -> ShowS
$cshowList :: [DValue] -> ShowS
show :: DValue -> String
$cshow :: DValue -> String
showsPrec :: Int -> DValue -> ShowS
$cshowsPrec :: Int -> DValue -> ShowS
Show,ReadPrec [DValue]
ReadPrec DValue
Int -> ReadS DValue
ReadS [DValue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DValue]
$creadListPrec :: ReadPrec [DValue]
readPrec :: ReadPrec DValue
$creadPrec :: ReadPrec DValue
readList :: ReadS [DValue]
$creadList :: ReadS [DValue]
readsPrec :: Int -> ReadS DValue
$creadsPrec :: Int -> ReadS DValue
Read,Eq DValue
DValue -> DValue -> Bool
DValue -> DValue -> Ordering
DValue -> DValue -> DValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DValue -> DValue -> DValue
$cmin :: DValue -> DValue -> DValue
max :: DValue -> DValue -> DValue
$cmax :: DValue -> DValue -> DValue
>= :: DValue -> DValue -> Bool
$c>= :: DValue -> DValue -> Bool
> :: DValue -> DValue -> Bool
$c> :: DValue -> DValue -> Bool
<= :: DValue -> DValue -> Bool
$c<= :: DValue -> DValue -> Bool
< :: DValue -> DValue -> Bool
$c< :: DValue -> DValue -> Bool
compare :: DValue -> DValue -> Ordering
$ccompare :: DValue -> DValue -> Ordering
Ord,Typeable)


instance IsString DValue where
    fromString :: String -> DValue
fromString String
t = Text -> DValue
DString (String -> Text
T.pack String
t)

-------------------------------------------------------------------------------
-- | Primary keys consist of either just a Hash key (mandatory) or a
-- hash key and a range key (optional).
data PrimaryKey = PrimaryKey {
      PrimaryKey -> Attribute
pkHash  :: Attribute
    , PrimaryKey -> Maybe Attribute
pkRange :: Maybe Attribute
    } deriving (ReadPrec [PrimaryKey]
ReadPrec PrimaryKey
Int -> ReadS PrimaryKey
ReadS [PrimaryKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PrimaryKey]
$creadListPrec :: ReadPrec [PrimaryKey]
readPrec :: ReadPrec PrimaryKey
$creadPrec :: ReadPrec PrimaryKey
readList :: ReadS [PrimaryKey]
$creadList :: ReadS [PrimaryKey]
readsPrec :: Int -> ReadS PrimaryKey
$creadsPrec :: Int -> ReadS PrimaryKey
Read,Int -> PrimaryKey -> ShowS
[PrimaryKey] -> ShowS
PrimaryKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimaryKey] -> ShowS
$cshowList :: [PrimaryKey] -> ShowS
show :: PrimaryKey -> String
$cshow :: PrimaryKey -> String
showsPrec :: Int -> PrimaryKey -> ShowS
$cshowsPrec :: Int -> PrimaryKey -> ShowS
Show,Eq PrimaryKey
PrimaryKey -> PrimaryKey -> Bool
PrimaryKey -> PrimaryKey -> Ordering
PrimaryKey -> PrimaryKey -> PrimaryKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrimaryKey -> PrimaryKey -> PrimaryKey
$cmin :: PrimaryKey -> PrimaryKey -> PrimaryKey
max :: PrimaryKey -> PrimaryKey -> PrimaryKey
$cmax :: PrimaryKey -> PrimaryKey -> PrimaryKey
>= :: PrimaryKey -> PrimaryKey -> Bool
$c>= :: PrimaryKey -> PrimaryKey -> Bool
> :: PrimaryKey -> PrimaryKey -> Bool
$c> :: PrimaryKey -> PrimaryKey -> Bool
<= :: PrimaryKey -> PrimaryKey -> Bool
$c<= :: PrimaryKey -> PrimaryKey -> Bool
< :: PrimaryKey -> PrimaryKey -> Bool
$c< :: PrimaryKey -> PrimaryKey -> Bool
compare :: PrimaryKey -> PrimaryKey -> Ordering
$ccompare :: PrimaryKey -> PrimaryKey -> Ordering
Ord,PrimaryKey -> PrimaryKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimaryKey -> PrimaryKey -> Bool
$c/= :: PrimaryKey -> PrimaryKey -> Bool
== :: PrimaryKey -> PrimaryKey -> Bool
$c== :: PrimaryKey -> PrimaryKey -> Bool
Eq,Typeable)


-------------------------------------------------------------------------------
-- | Construct a hash-only primary key.
--
-- >>> hk "user-id" "ABCD"
--
-- >>> hk "user-id" (mkVal 23)
hk :: T.Text -> DValue -> PrimaryKey
hk :: Text -> DValue -> PrimaryKey
hk Text
k DValue
v = Attribute -> Maybe Attribute -> PrimaryKey
PrimaryKey (forall a. DynVal a => Text -> a -> Attribute
attr Text
k DValue
v) forall a. Maybe a
Nothing


-------------------------------------------------------------------------------
-- | Construct a hash-and-range primary key.
hrk :: T.Text                   -- ^ Hash key name
    -> DValue                   -- ^ Hash key value
    -> T.Text                   -- ^ Range key name
    -> DValue                   -- ^ Range key value
    -> PrimaryKey
hrk :: Text -> DValue -> Text -> DValue -> PrimaryKey
hrk Text
k DValue
v Text
k2 DValue
v2 = Attribute -> Maybe Attribute -> PrimaryKey
PrimaryKey (forall a. DynVal a => Text -> a -> Attribute
attr Text
k DValue
v) (forall a. a -> Maybe a
Just (forall a. DynVal a => Text -> a -> Attribute
attr Text
k2 DValue
v2))


instance ToJSON PrimaryKey where
    toJSON :: PrimaryKey -> Value
toJSON (PrimaryKey Attribute
h Maybe Attribute
Nothing) = forall a. ToJSON a => a -> Value
toJSON Attribute
h
    toJSON (PrimaryKey Attribute
h (Just Attribute
r)) =
      let Object Object
p1 = forall a. ToJSON a => a -> Value
toJSON Attribute
h
          Object Object
p2 = forall a. ToJSON a => a -> Value
toJSON Attribute
r
      in Object -> Value
Object (Object
p1 forall v. KeyMap v -> KeyMap v -> KeyMap v
`KM.union` Object
p2)

instance FromJSON PrimaryKey where
    parseJSON :: Value -> Parser PrimaryKey
parseJSON Value
p = do
       [PrimaryKey]
l <- Value -> Parser [PrimaryKey]
listPKey Value
p
       case forall (t :: * -> *) a. Foldable t => t a -> Int
length [PrimaryKey]
l of
          Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [PrimaryKey]
l 
          Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse PrimaryKey"     
      where listPKey :: Value -> Parser [PrimaryKey]
listPKey Value
p'= forall a b. (a -> b) -> [a] -> [b]
map (\(Key
k,DValue
dval)-> Text -> DValue -> PrimaryKey
hk (Key -> Text
AK.toText Key
k) DValue
dval)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> [(Key, v)]
KM.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
p'


-- | A key-value pair
data Attribute = Attribute {
      Attribute -> Text
attrName :: T.Text
    , Attribute -> DValue
attrVal  :: DValue
    } deriving (ReadPrec [Attribute]
ReadPrec Attribute
Int -> ReadS Attribute
ReadS [Attribute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Attribute]
$creadListPrec :: ReadPrec [Attribute]
readPrec :: ReadPrec Attribute
$creadPrec :: ReadPrec Attribute
readList :: ReadS [Attribute]
$creadList :: ReadS [Attribute]
readsPrec :: Int -> ReadS Attribute
$creadsPrec :: Int -> ReadS Attribute
Read,Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show,Eq Attribute
Attribute -> Attribute -> Bool
Attribute -> Attribute -> Ordering
Attribute -> Attribute -> Attribute
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Attribute -> Attribute -> Attribute
$cmin :: Attribute -> Attribute -> Attribute
max :: Attribute -> Attribute -> Attribute
$cmax :: Attribute -> Attribute -> Attribute
>= :: Attribute -> Attribute -> Bool
$c>= :: Attribute -> Attribute -> Bool
> :: Attribute -> Attribute -> Bool
$c> :: Attribute -> Attribute -> Bool
<= :: Attribute -> Attribute -> Bool
$c<= :: Attribute -> Attribute -> Bool
< :: Attribute -> Attribute -> Bool
$c< :: Attribute -> Attribute -> Bool
compare :: Attribute -> Attribute -> Ordering
$ccompare :: Attribute -> Attribute -> Ordering
Ord,Attribute -> Attribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq,Typeable)


-- | Convert attribute to a tuple representation
attrTuple :: Attribute -> (T.Text, DValue)
attrTuple :: Attribute -> (Text, DValue)
attrTuple (Attribute Text
a DValue
b) = (Text
a,DValue
b)


-- | Convenience function for constructing key-value pairs
attr :: DynVal a => T.Text -> a -> Attribute
attr :: forall a. DynVal a => Text -> a -> Attribute
attr Text
k a
v = Text -> DValue -> Attribute
Attribute Text
k (forall a. DynVal a => a -> DValue
toValue a
v)


-- | 'attr' with type witness to help with cases where you're manually
-- supplying values in code.
--
-- >> item [ attrAs text "name" "john" ]
attrAs :: DynVal a => Proxy a -> T.Text -> a -> Attribute
attrAs :: forall a. DynVal a => Proxy a -> Text -> a -> Attribute
attrAs Proxy a
_ Text
k a
v = forall a. DynVal a => Text -> a -> Attribute
attr Text
k a
v


-- | Type witness for 'Text'. See 'attrAs'.
text :: Proxy T.Text
text :: Proxy Text
text = forall {k} (t :: k). Proxy t
Proxy


-- | Type witness for 'Integer'. See 'attrAs'.
int :: Proxy Integer
int :: Proxy Integer
int = forall {k} (t :: k). Proxy t
Proxy


-- | Type witness for 'Double'. See 'attrAs'.
double :: Proxy Double
double :: Proxy Double
double = forall {k} (t :: k). Proxy t
Proxy


-- | A DynamoDb object is simply a key-value dictionary.
type Item = M.Map T.Text DValue


-------------------------------------------------------------------------------
-- | Pack a list of attributes into an Item.
item :: [Attribute] -> Item
item :: [Attribute] -> Map Text DValue
item = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Attribute -> (Text, DValue)
attrTuple


-------------------------------------------------------------------------------
-- | Unpack an 'Item' into a list of attributes.
attributes :: M.Map T.Text DValue -> [Attribute]
attributes :: Map Text DValue -> [Attribute]
attributes = forall a b. (a -> b) -> [a] -> [b]
map (\ (Text
k, DValue
v) -> Text -> DValue -> Attribute
Attribute Text
k DValue
v) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList


showT :: Show a => a -> T.Text
showT :: forall a. Show a => a -> Text
showT = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


instance ToJSON DValue where
    toJSON :: DValue -> Value
toJSON DValue
DNull = [Pair] -> Value
object [Key
"NULL" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True]
    toJSON (DNum Scientific
i) = [Pair] -> Value
object [Key
"N" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> Text
showT Scientific
i]
    toJSON (DString Text
i) = [Pair] -> Value
object [Key
"S" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
i]
    toJSON (DBinary ByteString
i) = [Pair] -> Value
object [Key
"B" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (ByteString -> Text
T.decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base64.encode ByteString
i)]
    toJSON (DNumSet Set Scientific
i) = [Pair] -> Value
object [Key
"NS" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> Text
showT (forall a. Set a -> [a]
S.toList Set Scientific
i)]
    toJSON (DStringSet Set Text
i) = [Pair] -> Value
object [Key
"SS" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Set a -> [a]
S.toList Set Text
i]
    toJSON (DBinSet Set ByteString
i) = [Pair] -> Value
object [Key
"BS" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode) (forall a. Set a -> [a]
S.toList Set ByteString
i)]
    toJSON (DBool Bool
i) = [Pair] -> Value
object [Key
"BOOL" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
i]
    toJSON (DList Vector DValue
i) = [Pair] -> Value
object [Key
"L" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector DValue
i]
    toJSON (DMap Map Text DValue
i) = [Pair] -> Value
object [Key
"M" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text DValue
i]
    toJSON DValue
x = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"aws: bug: DynamoDB can't handle " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DValue
x


instance FromJSON DValue where
    parseJSON :: Value -> Parser DValue
parseJSON Value
o = do
      ([(Text, Value)]
obj :: [(T.Text, Value)]) <- forall k a. Map k a -> [(k, a)]
M.toList forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
      case [(Text, Value)]
obj of
        [(Text
"NULL", Value
_)] -> forall (m :: * -> *) a. Monad m => a -> m a
return DValue
DNull
        [(Text
"N", Value
numStr)] -> Scientific -> DValue
DNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *}. MonadFail m => Value -> m Scientific
parseScientific Value
numStr
        [(Text
"S", Value
str)] -> Text -> DValue
DString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
str
        [(Text
"B", Value
bin)] -> do
            Either String ByteString
res <- (ByteString -> Either String ByteString
Base64.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
bin
            forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DValue
DBinary) Either String ByteString
res
        [(Text
"NS", Value
s)] -> do [Scientific]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}. MonadFail m => Value -> m Scientific
parseScientific forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. FromJSON a => Value -> Parser a
parseJSON Value
s
                          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Set Scientific -> DValue
DNumSet forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList [Scientific]
xs
        [(Text
"SS", Value
s)] -> Set Text -> DValue
DStringSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
s
        [(Text
"BS", Value
s)] -> do
            [ByteString]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
Base64.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8)
                  forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. FromJSON a => Value -> Parser a
parseJSON Value
s
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Set ByteString -> DValue
DBinSet forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList [ByteString]
xs
        [(Text
"BOOL", Value
b)] -> Bool -> DValue
DBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
b
        [(Text
"L", Value
attrs)] -> Vector DValue -> DValue
DList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
attrs
        [(Text
"M", Value
attrs)] -> Map Text DValue -> DValue
DMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
attrs

        [(Text, Value)]
x -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"aws: unknown dynamodb value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [(Text, Value)]
x

      where
        parseScientific :: Value -> m Scientific
parseScientific (String Text
str) =
            case forall a. Parser a -> Text -> Either String a
Atto.parseOnly Parser Scientific
Atto.scientific Text
str of
              Left String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"parseScientific failed: " forall a. [a] -> [a] -> [a]
++ String
e)
              Right Scientific
a -> forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
a
        parseScientific (Number Scientific
n) = forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
n
        parseScientific Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected JSON type in parseScientific"


instance ToJSON Attribute where
    toJSON :: Attribute -> Value
toJSON Attribute
a = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ [Attribute -> Pair
attributeJson Attribute
a]


-------------------------------------------------------------------------------
-- | Parse a JSON object that contains attributes
parseAttributeJson :: Value -> A.Parser [Attribute]
parseAttributeJson :: Value -> Parser [Attribute]
parseAttributeJson (Object Object
v) = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pair -> Parser Attribute
conv forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [(Key, v)]
KM.toList Object
v
    where
      conv :: Pair -> Parser Attribute
conv (Key
k, Value
o) = Text -> DValue -> Attribute
Attribute (Key -> Text
AK.toText Key
k) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
parseAttributeJson Value
_ = forall a. HasCallStack => String -> a
error String
"Attribute JSON must be an Object"


-- | Convert into JSON object for AWS.
attributesJson :: [Attribute] -> Value
attributesJson :: [Attribute] -> Value
attributesJson [Attribute]
as = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Attribute -> Pair
attributeJson [Attribute]
as


-- | Convert into JSON pair
attributeJson :: Attribute -> Pair
attributeJson :: Attribute -> Pair
attributeJson (Attribute Text
nm DValue
v) = Text -> Key
AK.fromText Text
nm forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DValue
v


-------------------------------------------------------------------------------
-- | Errors defined by AWS.
data DdbErrCode
    = AccessDeniedException
    | ConditionalCheckFailedException
    | IncompleteSignatureException
    | InvalidSignatureException
    | LimitExceededException
    | MissingAuthenticationTokenException
    | ProvisionedThroughputExceededException
    | ResourceInUseException
    | ResourceNotFoundException
    | ThrottlingException
    | ValidationException
    | RequestTooLarge
    | InternalFailure
    | InternalServerError
    | ServiceUnavailableException
    | SerializationException
    -- ^ Raised by AWS when the request JSON is missing fields or is
    -- somehow malformed.
    deriving (ReadPrec [DdbErrCode]
ReadPrec DdbErrCode
Int -> ReadS DdbErrCode
ReadS [DdbErrCode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DdbErrCode]
$creadListPrec :: ReadPrec [DdbErrCode]
readPrec :: ReadPrec DdbErrCode
$creadPrec :: ReadPrec DdbErrCode
readList :: ReadS [DdbErrCode]
$creadList :: ReadS [DdbErrCode]
readsPrec :: Int -> ReadS DdbErrCode
$creadsPrec :: Int -> ReadS DdbErrCode
Read,Int -> DdbErrCode -> ShowS
[DdbErrCode] -> ShowS
DdbErrCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DdbErrCode] -> ShowS
$cshowList :: [DdbErrCode] -> ShowS
show :: DdbErrCode -> String
$cshow :: DdbErrCode -> String
showsPrec :: Int -> DdbErrCode -> ShowS
$cshowsPrec :: Int -> DdbErrCode -> ShowS
Show,DdbErrCode -> DdbErrCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DdbErrCode -> DdbErrCode -> Bool
$c/= :: DdbErrCode -> DdbErrCode -> Bool
== :: DdbErrCode -> DdbErrCode -> Bool
$c== :: DdbErrCode -> DdbErrCode -> Bool
Eq,Typeable)


-------------------------------------------------------------------------------
-- | Whether the action should be retried based on the received error.
shouldRetry :: DdbErrCode -> Bool
shouldRetry :: DdbErrCode -> Bool
shouldRetry DdbErrCode
e = DdbErrCode -> Bool
go DdbErrCode
e
    where
      go :: DdbErrCode -> Bool
go DdbErrCode
LimitExceededException = Bool
True
      go DdbErrCode
ProvisionedThroughputExceededException = Bool
True
      go DdbErrCode
ResourceInUseException = Bool
True
      go DdbErrCode
ThrottlingException = Bool
True
      go DdbErrCode
InternalFailure = Bool
True
      go DdbErrCode
InternalServerError = Bool
True
      go DdbErrCode
ServiceUnavailableException = Bool
True
      go DdbErrCode
_ = Bool
False


-------------------------------------------------------------------------------
-- | Errors related to this library.
data DdbLibraryError
    = UnknownDynamoErrCode T.Text
    -- ^ A DynamoDB error code we do not know about.
    | JsonProtocolError Value T.Text
    -- ^ A JSON response we could not parse.
    deriving (Int -> DdbLibraryError -> ShowS
[DdbLibraryError] -> ShowS
DdbLibraryError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DdbLibraryError] -> ShowS
$cshowList :: [DdbLibraryError] -> ShowS
show :: DdbLibraryError -> String
$cshow :: DdbLibraryError -> String
showsPrec :: Int -> DdbLibraryError -> ShowS
$cshowsPrec :: Int -> DdbLibraryError -> ShowS
Show,DdbLibraryError -> DdbLibraryError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DdbLibraryError -> DdbLibraryError -> Bool
$c/= :: DdbLibraryError -> DdbLibraryError -> Bool
== :: DdbLibraryError -> DdbLibraryError -> Bool
$c== :: DdbLibraryError -> DdbLibraryError -> Bool
Eq,Typeable)


-- | Potential errors raised by DynamoDB
data DdbError = DdbError {
      DdbError -> Int
ddbStatusCode :: Int
    -- ^ 200 if successful, 400 for client errors and 500 for
    -- server-side errors.
    , DdbError -> DdbErrCode
ddbErrCode    :: DdbErrCode
    , DdbError -> Text
ddbErrMsg     :: T.Text
    } deriving (Int -> DdbError -> ShowS
[DdbError] -> ShowS
DdbError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DdbError] -> ShowS
$cshowList :: [DdbError] -> ShowS
show :: DdbError -> String
$cshow :: DdbError -> String
showsPrec :: Int -> DdbError -> ShowS
$cshowsPrec :: Int -> DdbError -> ShowS
Show,DdbError -> DdbError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DdbError -> DdbError -> Bool
$c/= :: DdbError -> DdbError -> Bool
== :: DdbError -> DdbError -> Bool
$c== :: DdbError -> DdbError -> Bool
Eq,Typeable)


instance C.Exception DdbError
instance C.Exception DdbLibraryError


-- | Response metadata that is present in every DynamoDB response.
data DdbResponse = DdbResponse {
      DdbResponse -> Maybe Text
ddbrCrc   :: Maybe T.Text
    , DdbResponse -> Maybe Text
ddbrMsgId :: Maybe T.Text
    }


instance Loggable DdbResponse where
    toLogText :: DdbResponse -> Text
toLogText (DdbResponse Maybe Text
id2 Maybe Text
rid) =
        Text
"DynamoDB: request ID=" forall a. Monoid a => a -> a -> a
`mappend`
        forall a. a -> Maybe a -> a
fromMaybe Text
"<none>" Maybe Text
rid forall a. Monoid a => a -> a -> a
`mappend`
        Text
", x-amz-id-2=" forall a. Monoid a => a -> a -> a
`mappend`
        forall a. a -> Maybe a -> a
fromMaybe Text
"<none>" Maybe Text
id2

instance Sem.Semigroup DdbResponse where
    DdbResponse
a <> :: DdbResponse -> DdbResponse -> DdbResponse
<> DdbResponse
b = Maybe Text -> Maybe Text -> DdbResponse
DdbResponse (DdbResponse -> Maybe Text
ddbrCrc DdbResponse
a forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` DdbResponse -> Maybe Text
ddbrCrc DdbResponse
b) (DdbResponse -> Maybe Text
ddbrMsgId DdbResponse
a forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` DdbResponse -> Maybe Text
ddbrMsgId DdbResponse
b)

instance Monoid DdbResponse where
    mempty :: DdbResponse
mempty = Maybe Text -> Maybe Text -> DdbResponse
DdbResponse forall a. Maybe a
Nothing forall a. Maybe a
Nothing
    mappend :: DdbResponse -> DdbResponse -> DdbResponse
mappend = forall a. Semigroup a => a -> a -> a
(Sem.<>)


data Region = Region {
      Region -> ByteString
rUri  :: B.ByteString
    , Region -> ByteString
rName :: B.ByteString
    } deriving (Region -> Region -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c== :: Region -> Region -> Bool
Eq,Int -> Region -> ShowS
[Region] -> ShowS
Region -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Region] -> ShowS
$cshowList :: [Region] -> ShowS
show :: Region -> String
$cshow :: Region -> String
showsPrec :: Int -> Region -> ShowS
$cshowsPrec :: Int -> Region -> ShowS
Show,ReadPrec [Region]
ReadPrec Region
Int -> ReadS Region
ReadS [Region]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Region]
$creadListPrec :: ReadPrec [Region]
readPrec :: ReadPrec Region
$creadPrec :: ReadPrec Region
readList :: ReadS [Region]
$creadList :: ReadS [Region]
readsPrec :: Int -> ReadS Region
$creadsPrec :: Int -> ReadS Region
Read,Typeable)


data DdbConfiguration qt = DdbConfiguration {
      forall qt. DdbConfiguration qt -> Region
ddbcRegion   :: Region
    -- ^ The regional endpoint. Ex: 'ddbUsEast'
    , forall qt. DdbConfiguration qt -> Protocol
ddbcProtocol :: Protocol
    -- ^ 'HTTP' or 'HTTPS'
    , forall qt. DdbConfiguration qt -> Maybe Int
ddbcPort     :: Maybe Int
    -- ^ Port override (mostly for local dev connection)
    } deriving (Int -> DdbConfiguration qt -> ShowS
forall qt. Int -> DdbConfiguration qt -> ShowS
forall qt. [DdbConfiguration qt] -> ShowS
forall qt. DdbConfiguration qt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DdbConfiguration qt] -> ShowS
$cshowList :: forall qt. [DdbConfiguration qt] -> ShowS
show :: DdbConfiguration qt -> String
$cshow :: forall qt. DdbConfiguration qt -> String
showsPrec :: Int -> DdbConfiguration qt -> ShowS
$cshowsPrec :: forall qt. Int -> DdbConfiguration qt -> ShowS
Show,Typeable)

instance Default (DdbConfiguration NormalQuery) where
    def :: DdbConfiguration NormalQuery
def = forall qt. Region -> Protocol -> Maybe Int -> DdbConfiguration qt
DdbConfiguration Region
ddbUsEast1 Protocol
HTTPS forall a. Maybe a
Nothing

instance DefaultServiceConfiguration (DdbConfiguration NormalQuery) where
  defServiceConfig :: DdbConfiguration NormalQuery
defServiceConfig = Region -> DdbConfiguration NormalQuery
ddbHttps Region
ddbUsEast1
  debugServiceConfig :: DdbConfiguration NormalQuery
debugServiceConfig = Region -> DdbConfiguration NormalQuery
ddbHttp Region
ddbUsEast1


-------------------------------------------------------------------------------
-- | DynamoDb local connection (for development)
ddbLocal :: Region
ddbLocal :: Region
ddbLocal = ByteString -> ByteString -> Region
Region ByteString
"127.0.0.1" ByteString
"local"

ddbUsEast1 :: Region
ddbUsEast1 :: Region
ddbUsEast1 = ByteString -> ByteString -> Region
Region ByteString
"dynamodb.us-east-1.amazonaws.com" ByteString
"us-east-1"

ddbUsWest1 :: Region
ddbUsWest1 :: Region
ddbUsWest1 = ByteString -> ByteString -> Region
Region ByteString
"dynamodb.us-west-1.amazonaws.com" ByteString
"us-west-1"

ddbUsWest2 :: Region
ddbUsWest2 :: Region
ddbUsWest2 = ByteString -> ByteString -> Region
Region ByteString
"dynamodb.us-west-2.amazonaws.com" ByteString
"us-west-2"

ddbEuWest1 :: Region
ddbEuWest1 :: Region
ddbEuWest1 = ByteString -> ByteString -> Region
Region ByteString
"dynamodb.eu-west-1.amazonaws.com" ByteString
"eu-west-1"

ddbEuWest2 :: Region
ddbEuWest2 :: Region
ddbEuWest2 = ByteString -> ByteString -> Region
Region ByteString
"dynamodb.eu-west-2.amazonaws.com" ByteString
"eu-west-2"

ddbEuCentral1 :: Region
ddbEuCentral1 :: Region
ddbEuCentral1 = ByteString -> ByteString -> Region
Region ByteString
"dynamodb.eu-central-1.amazonaws.com" ByteString
"eu-central-1"

ddbApNe1 :: Region
ddbApNe1 :: Region
ddbApNe1 = ByteString -> ByteString -> Region
Region ByteString
"dynamodb.ap-northeast-1.amazonaws.com" ByteString
"ap-northeast-1"

ddbApSe1 :: Region
ddbApSe1 :: Region
ddbApSe1 = ByteString -> ByteString -> Region
Region ByteString
"dynamodb.ap-southeast-1.amazonaws.com" ByteString
"ap-southeast-1"

ddbApSe2 :: Region
ddbApSe2 :: Region
ddbApSe2 = ByteString -> ByteString -> Region
Region ByteString
"dynamodb.ap-southeast-2.amazonaws.com" ByteString
"ap-southeast-2"

ddbSaEast1 :: Region
ddbSaEast1 :: Region
ddbSaEast1 = ByteString -> ByteString -> Region
Region ByteString
"dynamodb.sa-east-1.amazonaws.com" ByteString
"sa-east-1"

ddbHttp :: Region -> DdbConfiguration NormalQuery
ddbHttp :: Region -> DdbConfiguration NormalQuery
ddbHttp Region
endpoint = forall qt. Region -> Protocol -> Maybe Int -> DdbConfiguration qt
DdbConfiguration Region
endpoint Protocol
HTTP forall a. Maybe a
Nothing

ddbHttps :: Region -> DdbConfiguration NormalQuery
ddbHttps :: Region -> DdbConfiguration NormalQuery
ddbHttps Region
endpoint = forall qt. Region -> Protocol -> Maybe Int -> DdbConfiguration qt
DdbConfiguration Region
endpoint Protocol
HTTPS forall a. Maybe a
Nothing


ddbSignQuery
    :: A.ToJSON a
    => B.ByteString
    -> a
    -> DdbConfiguration qt
    -> SignatureData
    -> SignedQuery
ddbSignQuery :: forall a qt.
ToJSON a =>
ByteString
-> a -> DdbConfiguration qt -> SignatureData -> SignedQuery
ddbSignQuery ByteString
target a
body DdbConfiguration qt
di SignatureData
sd
    = SignedQuery {
        sqMethod :: Method
sqMethod = Method
Post
      , sqProtocol :: Protocol
sqProtocol = forall qt. DdbConfiguration qt -> Protocol
ddbcProtocol DdbConfiguration qt
di
      , sqHost :: ByteString
sqHost = ByteString
host
      , sqPort :: Int
sqPort = forall a. a -> Maybe a -> a
fromMaybe (Protocol -> Int
defaultPort (forall qt. DdbConfiguration qt -> Protocol
ddbcProtocol DdbConfiguration qt
di)) (forall qt. DdbConfiguration qt -> Maybe Int
ddbcPort DdbConfiguration qt
di)
      , sqPath :: ByteString
sqPath = ByteString
"/"
      , sqQuery :: Query
sqQuery = []
      , sqDate :: Maybe UTCTime
sqDate = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SignatureData -> UTCTime
signatureTime SignatureData
sd
      , sqAuthorization :: Maybe (IO ByteString)
sqAuthorization = forall a. a -> Maybe a
Just IO ByteString
auth
      , sqContentType :: Maybe ByteString
sqContentType = forall a. a -> Maybe a
Just ByteString
"application/x-amz-json-1.0"
      , sqContentMd5 :: Maybe (Digest MD5)
sqContentMd5 = forall a. Maybe a
Nothing
      , sqAmzHeaders :: RequestHeaders
sqAmzHeaders = RequestHeaders
amzHeaders forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ByteString
tok -> [(CI ByteString
"x-amz-security-token",ByteString
tok)]) (Credentials -> Maybe ByteString
iamToken Credentials
credentials)
      , sqOtherHeaders :: RequestHeaders
sqOtherHeaders = []
      , sqBody :: Maybe RequestBody
sqBody = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> RequestBody
HTTP.RequestBodyLBS ByteString
bodyLBS
      , sqStringToSign :: ByteString
sqStringToSign = ByteString
canonicalRequest
      }
    where
        credentials :: Credentials
credentials = SignatureData -> Credentials
signatureCredentials SignatureData
sd

        Region{ByteString
rName :: ByteString
rUri :: ByteString
rName :: Region -> ByteString
rUri :: Region -> ByteString
..} = forall qt. DdbConfiguration qt -> Region
ddbcRegion DdbConfiguration qt
di
        host :: ByteString
host = ByteString
rUri

        sigTime :: ByteString
sigTime = String -> UTCTime -> ByteString
fmtTime String
"%Y%m%dT%H%M%SZ" forall a b. (a -> b) -> a -> b
$ SignatureData -> UTCTime
signatureTime SignatureData
sd

        bodyLBS :: ByteString
bodyLBS = forall a. ToJSON a => a -> ByteString
A.encode a
body
        bodyHash :: ByteString
bodyHash = ByteString -> ByteString
Base16.encode forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (forall a. HashAlgorithm a => ByteString -> Digest a
CH.hashlazy ByteString
bodyLBS :: CH.Digest CH.SHA256)

        -- for some reason AWS doesn't want the x-amz-security-token in the canonical request
        amzHeaders :: RequestHeaders
amzHeaders = [ (CI ByteString
"x-amz-date", ByteString
sigTime)
                     , (CI ByteString
"x-amz-target", ByteString
dyApiVersion forall a. Semigroup a => a -> a -> a
Sem.<> ByteString
target)
                     ]

        canonicalHeaders :: RequestHeaders
canonicalHeaders = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ RequestHeaders
amzHeaders forall a. [a] -> [a] -> [a]
++
                           [(CI ByteString
"host", ByteString
host),
                            (CI ByteString
"content-type", ByteString
"application/x-amz-json-1.0")]

        canonicalRequest :: ByteString
canonicalRequest = [ByteString] -> ByteString
B.concat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate [ByteString
"\n"] (
                                    [ [ByteString
"POST"]
                                    , [ByteString
"/"]
                                    , [] -- query string
                                    ] forall a. [a] -> [a] -> [a]
++
                                    forall a b. (a -> b) -> [a] -> [b]
map (\(CI ByteString
a,ByteString
b) -> [forall s. CI s -> s
CI.foldedCase CI ByteString
a,ByteString
":",ByteString
b]) RequestHeaders
canonicalHeaders forall a. [a] -> [a] -> [a]
++
                                    [ [] -- end headers
                                    , forall a. a -> [a] -> [a]
intersperse ByteString
";" (forall a b. (a -> b) -> [a] -> [b]
map (forall s. CI s -> s
CI.foldedCase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) RequestHeaders
canonicalHeaders)
                                    , [ByteString
bodyHash]
                                    ])

        auth :: IO ByteString
auth = SignatureData
-> AuthorizationHash
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> IO ByteString
authorizationV4 SignatureData
sd AuthorizationHash
HmacSHA256 ByteString
rName ByteString
"dynamodb"
                               ByteString
"content-type;host;x-amz-date;x-amz-target"
                               ByteString
canonicalRequest

data AmazonError = AmazonError {
      AmazonError -> Text
aeType    :: T.Text
    , AmazonError -> Maybe Text
aeMessage :: Maybe T.Text
    }

instance FromJSON AmazonError where
    parseJSON :: Value -> Parser AmazonError
parseJSON (Object Object
v) = Text -> Maybe Text -> AmazonError
AmazonError
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"__type"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Message") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
    parseJSON Value
_ = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"aws: unexpected AmazonError message"




-------------------------------------------------------------------------------
ddbResponseConsumer :: A.FromJSON a => IORef DdbResponse -> HTTPResponseConsumer a
ddbResponseConsumer :: forall a. FromJSON a => IORef DdbResponse -> HTTPResponseConsumer a
ddbResponseConsumer IORef DdbResponse
ref Response (ConduitM () ByteString (ResourceT IO) ())
resp = do
    Value
val <- forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
HTTP.responseBody Response (ConduitM () ByteString (ResourceT IO) ())
resp forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall a (m :: * -> *) b o.
(AttoparsecInput a, MonadThrow m) =>
Parser a b -> ConduitT a o m b
sinkParser (Parser ByteString Value
A.json' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
AttoB.endOfInput)
    case Int
statusCode of
      Int
200 -> Value -> ResourceT IO a
rSuccess Value
val
      Int
_   -> Value -> ResourceT IO a
rError Value
val
  where

    header :: CI ByteString -> Maybe Text
header = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall body. Response body -> RequestHeaders
HTTP.responseHeaders Response (ConduitM () ByteString (ResourceT IO) ())
resp)
    amzId :: Maybe Text
amzId = CI ByteString -> Maybe Text
header CI ByteString
"x-amzn-RequestId"
    amzCrc :: Maybe Text
amzCrc = CI ByteString -> Maybe Text
header CI ByteString
"x-amz-crc32"
    meta :: DdbResponse
meta = Maybe Text -> Maybe Text -> DdbResponse
DdbResponse Maybe Text
amzCrc Maybe Text
amzId
    tellMeta :: ResourceT IO ()
tellMeta = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall m. Monoid m => IORef m -> m -> IO ()
tellMetadataRef IORef DdbResponse
ref DdbResponse
meta

    rSuccess :: Value -> ResourceT IO a
rSuccess Value
val =
      case forall a. FromJSON a => Value -> Result a
A.fromJSON Value
val of
        A.Success a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        A.Error String
err -> do
            ResourceT IO ()
tellMeta
            forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Value -> Text -> DdbLibraryError
JsonProtocolError Value
val (String -> Text
T.pack String
err)

    rError :: Value -> ResourceT IO a
rError Value
val = do
      ResourceT IO ()
tellMeta
      case forall a b. (a -> Parser b) -> a -> Either String b
parseEither forall a. FromJSON a => Value -> Parser a
parseJSON Value
val of
        Left String
e ->
          forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Value -> Text -> DdbLibraryError
JsonProtocolError Value
val (String -> Text
T.pack String
e)

        Right AmazonError
err'' -> do
          let e :: Text
e = Int -> Text -> Text
T.drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> (Text, Text)
T.breakOn Text
"#" forall a b. (a -> b) -> a -> b
$ AmazonError -> Text
aeType AmazonError
err''
          DdbErrCode
errCode <- forall {a} {m :: * -> *}. (Read a, MonadThrow m) => Text -> m a
readErrCode Text
e
          forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Int -> DdbErrCode -> Text -> DdbError
DdbError Int
statusCode DdbErrCode
errCode (forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ AmazonError -> Maybe Text
aeMessage AmazonError
err'')

    readErrCode :: Text -> m a
readErrCode Text
txt =
        let txt' :: String
txt' = Text -> String
T.unpack Text
txt
        in case forall a. Read a => String -> Maybe a
readMay String
txt' of
             Just a
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a
e
             Maybe a
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> DdbLibraryError
UnknownDynamoErrCode Text
txt)

    HTTP.Status{Int
ByteString
statusCode :: Status -> Int
statusMessage :: Status -> ByteString
statusMessage :: ByteString
statusCode :: Int
..} = forall body. Response body -> Status
HTTP.responseStatus Response (ConduitM () ByteString (ResourceT IO) ())
resp


-- | Conditions used by mutation operations ('PutItem', 'UpdateItem',
-- etc.). The default 'def' instance is empty (no condition).
data Conditions = Conditions CondMerge [Condition]
    deriving (Conditions -> Conditions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Conditions -> Conditions -> Bool
$c/= :: Conditions -> Conditions -> Bool
== :: Conditions -> Conditions -> Bool
$c== :: Conditions -> Conditions -> Bool
Eq,Int -> Conditions -> ShowS
[Conditions] -> ShowS
Conditions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Conditions] -> ShowS
$cshowList :: [Conditions] -> ShowS
show :: Conditions -> String
$cshow :: Conditions -> String
showsPrec :: Int -> Conditions -> ShowS
$cshowsPrec :: Int -> Conditions -> ShowS
Show,ReadPrec [Conditions]
ReadPrec Conditions
Int -> ReadS Conditions
ReadS [Conditions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Conditions]
$creadListPrec :: ReadPrec [Conditions]
readPrec :: ReadPrec Conditions
$creadPrec :: ReadPrec Conditions
readList :: ReadS [Conditions]
$creadList :: ReadS [Conditions]
readsPrec :: Int -> ReadS Conditions
$creadsPrec :: Int -> ReadS Conditions
Read,Eq Conditions
Conditions -> Conditions -> Bool
Conditions -> Conditions -> Ordering
Conditions -> Conditions -> Conditions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Conditions -> Conditions -> Conditions
$cmin :: Conditions -> Conditions -> Conditions
max :: Conditions -> Conditions -> Conditions
$cmax :: Conditions -> Conditions -> Conditions
>= :: Conditions -> Conditions -> Bool
$c>= :: Conditions -> Conditions -> Bool
> :: Conditions -> Conditions -> Bool
$c> :: Conditions -> Conditions -> Bool
<= :: Conditions -> Conditions -> Bool
$c<= :: Conditions -> Conditions -> Bool
< :: Conditions -> Conditions -> Bool
$c< :: Conditions -> Conditions -> Bool
compare :: Conditions -> Conditions -> Ordering
$ccompare :: Conditions -> Conditions -> Ordering
Ord,Typeable)

instance Default Conditions where
    def :: Conditions
def = CondMerge -> [Condition] -> Conditions
Conditions CondMerge
CondAnd []



expectsJson :: Conditions -> [A.Pair]
expectsJson :: Conditions -> [Pair]
expectsJson = Text -> Conditions -> [Pair]
conditionsJson Text
"Expected"


-- | JSON encoding of conditions parameter in various contexts.
conditionsJson :: T.Text -> Conditions -> [A.Pair]
conditionsJson :: Text -> Conditions -> [Pair]
conditionsJson Text
key (Conditions CondMerge
op [Condition]
es) = [Pair]
b forall a. [a] -> [a] -> [a]
++ [Pair]
a
    where
      a :: [Pair]
a = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Condition]
es
          then []
          else [Text -> Key
AK.fromText Text
key forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object (forall a b. (a -> b) -> [a] -> [b]
map Condition -> Pair
conditionJson [Condition]
es)]

      b :: [Pair]
b = if forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Int -> [a] -> [a]
take Int
2 [Condition]
es) forall a. Ord a => a -> a -> Bool
> Int
1
          then [Key
"ConditionalOperator" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (CondMerge -> Text
rendCondOp CondMerge
op) ]
          else []


-------------------------------------------------------------------------------
rendCondOp :: CondMerge -> T.Text
rendCondOp :: CondMerge -> Text
rendCondOp CondMerge
CondAnd = Text
"AND"
rendCondOp CondMerge
CondOr = Text
"OR"


-------------------------------------------------------------------------------
-- | How to merge multiple conditions.
data CondMerge = CondAnd | CondOr
    deriving (CondMerge -> CondMerge -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CondMerge -> CondMerge -> Bool
$c/= :: CondMerge -> CondMerge -> Bool
== :: CondMerge -> CondMerge -> Bool
$c== :: CondMerge -> CondMerge -> Bool
Eq,Int -> CondMerge -> ShowS
[CondMerge] -> ShowS
CondMerge -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CondMerge] -> ShowS
$cshowList :: [CondMerge] -> ShowS
show :: CondMerge -> String
$cshow :: CondMerge -> String
showsPrec :: Int -> CondMerge -> ShowS
$cshowsPrec :: Int -> CondMerge -> ShowS
Show,ReadPrec [CondMerge]
ReadPrec CondMerge
Int -> ReadS CondMerge
ReadS [CondMerge]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CondMerge]
$creadListPrec :: ReadPrec [CondMerge]
readPrec :: ReadPrec CondMerge
$creadPrec :: ReadPrec CondMerge
readList :: ReadS [CondMerge]
$creadList :: ReadS [CondMerge]
readsPrec :: Int -> ReadS CondMerge
$creadsPrec :: Int -> ReadS CondMerge
Read,Eq CondMerge
CondMerge -> CondMerge -> Bool
CondMerge -> CondMerge -> Ordering
CondMerge -> CondMerge -> CondMerge
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CondMerge -> CondMerge -> CondMerge
$cmin :: CondMerge -> CondMerge -> CondMerge
max :: CondMerge -> CondMerge -> CondMerge
$cmax :: CondMerge -> CondMerge -> CondMerge
>= :: CondMerge -> CondMerge -> Bool
$c>= :: CondMerge -> CondMerge -> Bool
> :: CondMerge -> CondMerge -> Bool
$c> :: CondMerge -> CondMerge -> Bool
<= :: CondMerge -> CondMerge -> Bool
$c<= :: CondMerge -> CondMerge -> Bool
< :: CondMerge -> CondMerge -> Bool
$c< :: CondMerge -> CondMerge -> Bool
compare :: CondMerge -> CondMerge -> Ordering
$ccompare :: CondMerge -> CondMerge -> Ordering
Ord,Typeable)


-- | A condition used by mutation operations ('PutItem', 'UpdateItem', etc.).
data Condition = Condition {
      Condition -> Text
condAttr :: T.Text
    -- ^ Attribute to use as the basis for this conditional
    , Condition -> CondOp
condOp   :: CondOp
    -- ^ Operation on the selected attribute
    } deriving (Condition -> Condition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c== :: Condition -> Condition -> Bool
Eq,Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Condition] -> ShowS
$cshowList :: [Condition] -> ShowS
show :: Condition -> String
$cshow :: Condition -> String
showsPrec :: Int -> Condition -> ShowS
$cshowsPrec :: Int -> Condition -> ShowS
Show,ReadPrec [Condition]
ReadPrec Condition
Int -> ReadS Condition
ReadS [Condition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Condition]
$creadListPrec :: ReadPrec [Condition]
readPrec :: ReadPrec Condition
$creadPrec :: ReadPrec Condition
readList :: ReadS [Condition]
$creadList :: ReadS [Condition]
readsPrec :: Int -> ReadS Condition
$creadsPrec :: Int -> ReadS Condition
Read,Eq Condition
Condition -> Condition -> Bool
Condition -> Condition -> Ordering
Condition -> Condition -> Condition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Condition -> Condition -> Condition
$cmin :: Condition -> Condition -> Condition
max :: Condition -> Condition -> Condition
$cmax :: Condition -> Condition -> Condition
>= :: Condition -> Condition -> Bool
$c>= :: Condition -> Condition -> Bool
> :: Condition -> Condition -> Bool
$c> :: Condition -> Condition -> Bool
<= :: Condition -> Condition -> Bool
$c<= :: Condition -> Condition -> Bool
< :: Condition -> Condition -> Bool
$c< :: Condition -> Condition -> Bool
compare :: Condition -> Condition -> Ordering
$ccompare :: Condition -> Condition -> Ordering
Ord,Typeable)


-------------------------------------------------------------------------------
-- | Conditional operation to perform on a field.
data CondOp
    = DEq DValue
    | NotEq DValue
    | DLE DValue
    | DLT DValue
    | DGE DValue
    | DGT DValue
    | NotNull
    | IsNull
    | Contains DValue
    | NotContains DValue
    | Begins DValue
    | In [DValue]
    | Between DValue DValue
    deriving (CondOp -> CondOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CondOp -> CondOp -> Bool
$c/= :: CondOp -> CondOp -> Bool
== :: CondOp -> CondOp -> Bool
$c== :: CondOp -> CondOp -> Bool
Eq,Int -> CondOp -> ShowS
[CondOp] -> ShowS
CondOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CondOp] -> ShowS
$cshowList :: [CondOp] -> ShowS
show :: CondOp -> String
$cshow :: CondOp -> String
showsPrec :: Int -> CondOp -> ShowS
$cshowsPrec :: Int -> CondOp -> ShowS
Show,ReadPrec [CondOp]
ReadPrec CondOp
Int -> ReadS CondOp
ReadS [CondOp]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CondOp]
$creadListPrec :: ReadPrec [CondOp]
readPrec :: ReadPrec CondOp
$creadPrec :: ReadPrec CondOp
readList :: ReadS [CondOp]
$creadList :: ReadS [CondOp]
readsPrec :: Int -> ReadS CondOp
$creadsPrec :: Int -> ReadS CondOp
Read,Eq CondOp
CondOp -> CondOp -> Bool
CondOp -> CondOp -> Ordering
CondOp -> CondOp -> CondOp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CondOp -> CondOp -> CondOp
$cmin :: CondOp -> CondOp -> CondOp
max :: CondOp -> CondOp -> CondOp
$cmax :: CondOp -> CondOp -> CondOp
>= :: CondOp -> CondOp -> Bool
$c>= :: CondOp -> CondOp -> Bool
> :: CondOp -> CondOp -> Bool
$c> :: CondOp -> CondOp -> Bool
<= :: CondOp -> CondOp -> Bool
$c<= :: CondOp -> CondOp -> Bool
< :: CondOp -> CondOp -> Bool
$c< :: CondOp -> CondOp -> Bool
compare :: CondOp -> CondOp -> Ordering
$ccompare :: CondOp -> CondOp -> Ordering
Ord,Typeable)


-------------------------------------------------------------------------------
getCondValues :: CondOp -> [DValue]
getCondValues :: CondOp -> [DValue]
getCondValues CondOp
c = case CondOp
c of
    DEq DValue
v -> [DValue
v]
    NotEq DValue
v -> [DValue
v]
    DLE DValue
v -> [DValue
v]
    DLT DValue
v -> [DValue
v]
    DGE DValue
v -> [DValue
v]
    DGT DValue
v -> [DValue
v]
    CondOp
NotNull -> []
    CondOp
IsNull -> []
    Contains DValue
v -> [DValue
v]
    NotContains DValue
v -> [DValue
v]
    Begins DValue
v -> [DValue
v]
    In [DValue]
v -> [DValue]
v
    Between DValue
a DValue
b -> [DValue
a,DValue
b]


-------------------------------------------------------------------------------
renderCondOp :: CondOp -> T.Text
renderCondOp :: CondOp -> Text
renderCondOp CondOp
c = case CondOp
c of
    DEq{} -> Text
"EQ"
    NotEq{} -> Text
"NE"
    DLE{} -> Text
"LE"
    DLT{} -> Text
"LT"
    DGE{} -> Text
"GE"
    DGT{} -> Text
"GT"
    CondOp
NotNull -> Text
"NOT_NULL"
    CondOp
IsNull -> Text
"NULL"
    Contains{} -> Text
"CONTAINS"
    NotContains{} -> Text
"NOT_CONTAINS"
    Begins{} -> Text
"BEGINS_WITH"
    In{} -> Text
"IN"
    Between{} -> Text
"BETWEEN"


conditionJson :: Condition -> Pair
conditionJson :: Condition -> Pair
conditionJson Condition{Text
CondOp
condOp :: CondOp
condAttr :: Text
condOp :: Condition -> CondOp
condAttr :: Condition -> Text
..} = Text -> Key
AK.fromText Text
condAttr forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CondOp
condOp


instance ToJSON CondOp where
    toJSON :: CondOp -> Value
toJSON CondOp
c = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ (Key
"ComparisonOperator" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (CondOp -> Text
renderCondOp CondOp
c)) forall a. a -> [a] -> [a]
: [Pair]
valueList
      where
        valueList :: [Pair]
valueList =
          let vs :: [DValue]
vs = CondOp -> [DValue]
getCondValues CondOp
c in
            if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DValue]
vs
            then []
            else [Key
"AttributeValueList" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [DValue]
vs]

-------------------------------------------------------------------------------
dyApiVersion :: B.ByteString
dyApiVersion :: ByteString
dyApiVersion = ByteString
"DynamoDB_20120810."



-------------------------------------------------------------------------------
-- | The standard response metrics on capacity consumption.
data ConsumedCapacity = ConsumedCapacity {
      ConsumedCapacity -> Int64
capacityUnits       :: Int64
    , ConsumedCapacity -> [(Text, Int64)]
capacityGlobalIndex :: [(T.Text, Int64)]
    , ConsumedCapacity -> [(Text, Int64)]
capacityLocalIndex  :: [(T.Text, Int64)]
    , ConsumedCapacity -> Maybe Int64
capacityTableUnits  :: Maybe Int64
    , ConsumedCapacity -> Text
capacityTable       :: T.Text
    } deriving (ConsumedCapacity -> ConsumedCapacity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConsumedCapacity -> ConsumedCapacity -> Bool
$c/= :: ConsumedCapacity -> ConsumedCapacity -> Bool
== :: ConsumedCapacity -> ConsumedCapacity -> Bool
$c== :: ConsumedCapacity -> ConsumedCapacity -> Bool
Eq,Int -> ConsumedCapacity -> ShowS
[ConsumedCapacity] -> ShowS
ConsumedCapacity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConsumedCapacity] -> ShowS
$cshowList :: [ConsumedCapacity] -> ShowS
show :: ConsumedCapacity -> String
$cshow :: ConsumedCapacity -> String
showsPrec :: Int -> ConsumedCapacity -> ShowS
$cshowsPrec :: Int -> ConsumedCapacity -> ShowS
Show,ReadPrec [ConsumedCapacity]
ReadPrec ConsumedCapacity
Int -> ReadS ConsumedCapacity
ReadS [ConsumedCapacity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConsumedCapacity]
$creadListPrec :: ReadPrec [ConsumedCapacity]
readPrec :: ReadPrec ConsumedCapacity
$creadPrec :: ReadPrec ConsumedCapacity
readList :: ReadS [ConsumedCapacity]
$creadList :: ReadS [ConsumedCapacity]
readsPrec :: Int -> ReadS ConsumedCapacity
$creadsPrec :: Int -> ReadS ConsumedCapacity
Read,Eq ConsumedCapacity
ConsumedCapacity -> ConsumedCapacity -> Bool
ConsumedCapacity -> ConsumedCapacity -> Ordering
ConsumedCapacity -> ConsumedCapacity -> ConsumedCapacity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConsumedCapacity -> ConsumedCapacity -> ConsumedCapacity
$cmin :: ConsumedCapacity -> ConsumedCapacity -> ConsumedCapacity
max :: ConsumedCapacity -> ConsumedCapacity -> ConsumedCapacity
$cmax :: ConsumedCapacity -> ConsumedCapacity -> ConsumedCapacity
>= :: ConsumedCapacity -> ConsumedCapacity -> Bool
$c>= :: ConsumedCapacity -> ConsumedCapacity -> Bool
> :: ConsumedCapacity -> ConsumedCapacity -> Bool
$c> :: ConsumedCapacity -> ConsumedCapacity -> Bool
<= :: ConsumedCapacity -> ConsumedCapacity -> Bool
$c<= :: ConsumedCapacity -> ConsumedCapacity -> Bool
< :: ConsumedCapacity -> ConsumedCapacity -> Bool
$c< :: ConsumedCapacity -> ConsumedCapacity -> Bool
compare :: ConsumedCapacity -> ConsumedCapacity -> Ordering
$ccompare :: ConsumedCapacity -> ConsumedCapacity -> Ordering
Ord,Typeable)


instance FromJSON ConsumedCapacity where
    parseJSON :: Value -> Parser ConsumedCapacity
parseJSON (Object Object
o) = Int64
-> [(Text, Int64)]
-> [(Text, Int64)]
-> Maybe Int64
-> Text
-> ConsumedCapacity
ConsumedCapacity
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"CapacityUnits"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b. (a -> b) -> [a] -> [b]
map (\(Key
k, Int64
v) -> (Key -> Text
AK.toText Key
k, Int64
v)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> [(Key, v)]
KM.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"GlobalSecondaryIndexes" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b. (a -> b) -> [a] -> [b]
map (\(Key
k, Int64
v) -> (Key -> Text
AK.toText Key
k, Int64
v)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> [(Key, v)]
KM.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"LocalSecondaryIndexes" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Table" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"CapacityUnits"))
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"TableName"
    parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ConsumedCapacity must be an Object."



data ReturnConsumption = RCIndexes | RCTotal | RCNone
    deriving (ReturnConsumption -> ReturnConsumption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReturnConsumption -> ReturnConsumption -> Bool
$c/= :: ReturnConsumption -> ReturnConsumption -> Bool
== :: ReturnConsumption -> ReturnConsumption -> Bool
$c== :: ReturnConsumption -> ReturnConsumption -> Bool
Eq,Int -> ReturnConsumption -> ShowS
[ReturnConsumption] -> ShowS
ReturnConsumption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReturnConsumption] -> ShowS
$cshowList :: [ReturnConsumption] -> ShowS
show :: ReturnConsumption -> String
$cshow :: ReturnConsumption -> String
showsPrec :: Int -> ReturnConsumption -> ShowS
$cshowsPrec :: Int -> ReturnConsumption -> ShowS
Show,ReadPrec [ReturnConsumption]
ReadPrec ReturnConsumption
Int -> ReadS ReturnConsumption
ReadS [ReturnConsumption]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReturnConsumption]
$creadListPrec :: ReadPrec [ReturnConsumption]
readPrec :: ReadPrec ReturnConsumption
$creadPrec :: ReadPrec ReturnConsumption
readList :: ReadS [ReturnConsumption]
$creadList :: ReadS [ReturnConsumption]
readsPrec :: Int -> ReadS ReturnConsumption
$creadsPrec :: Int -> ReadS ReturnConsumption
Read,Eq ReturnConsumption
ReturnConsumption -> ReturnConsumption -> Bool
ReturnConsumption -> ReturnConsumption -> Ordering
ReturnConsumption -> ReturnConsumption -> ReturnConsumption
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReturnConsumption -> ReturnConsumption -> ReturnConsumption
$cmin :: ReturnConsumption -> ReturnConsumption -> ReturnConsumption
max :: ReturnConsumption -> ReturnConsumption -> ReturnConsumption
$cmax :: ReturnConsumption -> ReturnConsumption -> ReturnConsumption
>= :: ReturnConsumption -> ReturnConsumption -> Bool
$c>= :: ReturnConsumption -> ReturnConsumption -> Bool
> :: ReturnConsumption -> ReturnConsumption -> Bool
$c> :: ReturnConsumption -> ReturnConsumption -> Bool
<= :: ReturnConsumption -> ReturnConsumption -> Bool
$c<= :: ReturnConsumption -> ReturnConsumption -> Bool
< :: ReturnConsumption -> ReturnConsumption -> Bool
$c< :: ReturnConsumption -> ReturnConsumption -> Bool
compare :: ReturnConsumption -> ReturnConsumption -> Ordering
$ccompare :: ReturnConsumption -> ReturnConsumption -> Ordering
Ord,Typeable)

instance ToJSON ReturnConsumption where
    toJSON :: ReturnConsumption -> Value
toJSON ReturnConsumption
RCIndexes = Text -> Value
String Text
"INDEXES"
    toJSON ReturnConsumption
RCTotal = Text -> Value
String Text
"TOTAL"
    toJSON ReturnConsumption
RCNone = Text -> Value
String Text
"NONE"

instance Default ReturnConsumption where
    def :: ReturnConsumption
def = ReturnConsumption
RCNone

data ReturnItemCollectionMetrics = RICMSize | RICMNone
    deriving (ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
$c/= :: ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
== :: ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
$c== :: ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
Eq,Int -> ReturnItemCollectionMetrics -> ShowS
[ReturnItemCollectionMetrics] -> ShowS
ReturnItemCollectionMetrics -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReturnItemCollectionMetrics] -> ShowS
$cshowList :: [ReturnItemCollectionMetrics] -> ShowS
show :: ReturnItemCollectionMetrics -> String
$cshow :: ReturnItemCollectionMetrics -> String
showsPrec :: Int -> ReturnItemCollectionMetrics -> ShowS
$cshowsPrec :: Int -> ReturnItemCollectionMetrics -> ShowS
Show,ReadPrec [ReturnItemCollectionMetrics]
ReadPrec ReturnItemCollectionMetrics
Int -> ReadS ReturnItemCollectionMetrics
ReadS [ReturnItemCollectionMetrics]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReturnItemCollectionMetrics]
$creadListPrec :: ReadPrec [ReturnItemCollectionMetrics]
readPrec :: ReadPrec ReturnItemCollectionMetrics
$creadPrec :: ReadPrec ReturnItemCollectionMetrics
readList :: ReadS [ReturnItemCollectionMetrics]
$creadList :: ReadS [ReturnItemCollectionMetrics]
readsPrec :: Int -> ReadS ReturnItemCollectionMetrics
$creadsPrec :: Int -> ReadS ReturnItemCollectionMetrics
Read,Eq ReturnItemCollectionMetrics
ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
ReturnItemCollectionMetrics
-> ReturnItemCollectionMetrics -> Ordering
ReturnItemCollectionMetrics
-> ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReturnItemCollectionMetrics
-> ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics
$cmin :: ReturnItemCollectionMetrics
-> ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics
max :: ReturnItemCollectionMetrics
-> ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics
$cmax :: ReturnItemCollectionMetrics
-> ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics
>= :: ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
$c>= :: ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
> :: ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
$c> :: ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
<= :: ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
$c<= :: ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
< :: ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
$c< :: ReturnItemCollectionMetrics -> ReturnItemCollectionMetrics -> Bool
compare :: ReturnItemCollectionMetrics
-> ReturnItemCollectionMetrics -> Ordering
$ccompare :: ReturnItemCollectionMetrics
-> ReturnItemCollectionMetrics -> Ordering
Ord,Typeable)

instance ToJSON ReturnItemCollectionMetrics where
    toJSON :: ReturnItemCollectionMetrics -> Value
toJSON ReturnItemCollectionMetrics
RICMSize = Text -> Value
String Text
"SIZE"
    toJSON ReturnItemCollectionMetrics
RICMNone = Text -> Value
String Text
"NONE"

instance Default ReturnItemCollectionMetrics where
    def :: ReturnItemCollectionMetrics
def = ReturnItemCollectionMetrics
RICMNone


data ItemCollectionMetrics = ItemCollectionMetrics {
      ItemCollectionMetrics -> (Text, DValue)
icmKey      :: (T.Text, DValue)
    , ItemCollectionMetrics -> [Double]
icmEstimate :: [Double]
    } deriving (ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
$c/= :: ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
== :: ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
$c== :: ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
Eq,Int -> ItemCollectionMetrics -> ShowS
[ItemCollectionMetrics] -> ShowS
ItemCollectionMetrics -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemCollectionMetrics] -> ShowS
$cshowList :: [ItemCollectionMetrics] -> ShowS
show :: ItemCollectionMetrics -> String
$cshow :: ItemCollectionMetrics -> String
showsPrec :: Int -> ItemCollectionMetrics -> ShowS
$cshowsPrec :: Int -> ItemCollectionMetrics -> ShowS
Show,ReadPrec [ItemCollectionMetrics]
ReadPrec ItemCollectionMetrics
Int -> ReadS ItemCollectionMetrics
ReadS [ItemCollectionMetrics]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ItemCollectionMetrics]
$creadListPrec :: ReadPrec [ItemCollectionMetrics]
readPrec :: ReadPrec ItemCollectionMetrics
$creadPrec :: ReadPrec ItemCollectionMetrics
readList :: ReadS [ItemCollectionMetrics]
$creadList :: ReadS [ItemCollectionMetrics]
readsPrec :: Int -> ReadS ItemCollectionMetrics
$creadsPrec :: Int -> ReadS ItemCollectionMetrics
Read,Eq ItemCollectionMetrics
ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
ItemCollectionMetrics -> ItemCollectionMetrics -> Ordering
ItemCollectionMetrics
-> ItemCollectionMetrics -> ItemCollectionMetrics
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ItemCollectionMetrics
-> ItemCollectionMetrics -> ItemCollectionMetrics
$cmin :: ItemCollectionMetrics
-> ItemCollectionMetrics -> ItemCollectionMetrics
max :: ItemCollectionMetrics
-> ItemCollectionMetrics -> ItemCollectionMetrics
$cmax :: ItemCollectionMetrics
-> ItemCollectionMetrics -> ItemCollectionMetrics
>= :: ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
$c>= :: ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
> :: ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
$c> :: ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
<= :: ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
$c<= :: ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
< :: ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
$c< :: ItemCollectionMetrics -> ItemCollectionMetrics -> Bool
compare :: ItemCollectionMetrics -> ItemCollectionMetrics -> Ordering
$ccompare :: ItemCollectionMetrics -> ItemCollectionMetrics -> Ordering
Ord,Typeable)


instance FromJSON ItemCollectionMetrics where
    parseJSON :: Value -> Parser ItemCollectionMetrics
parseJSON (Object Object
o) = (Text, DValue) -> [Double] -> ItemCollectionMetrics
ItemCollectionMetrics
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do KeyMap DValue
m <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ItemCollectionKey"
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\(Key
k, DValue
v) -> (Key -> Text
AK.toText Key
k, DValue
v)) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [(Key, v)]
KM.toList KeyMap DValue
m)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"SizeEstimateRangeGB"
    parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ItemCollectionMetrics must be an Object."


-------------------------------------------------------------------------------
-- | What to return from the current update operation
data UpdateReturn
    = URNone                    -- ^ Return nothing
    | URAllOld                  -- ^ Return old values
    | URUpdatedOld              -- ^ Return old values with a newer replacement
    | URAllNew                  -- ^ Return new values
    | URUpdatedNew              -- ^ Return new values that were replacements
    deriving (UpdateReturn -> UpdateReturn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateReturn -> UpdateReturn -> Bool
$c/= :: UpdateReturn -> UpdateReturn -> Bool
== :: UpdateReturn -> UpdateReturn -> Bool
$c== :: UpdateReturn -> UpdateReturn -> Bool
Eq,Int -> UpdateReturn -> ShowS
[UpdateReturn] -> ShowS
UpdateReturn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateReturn] -> ShowS
$cshowList :: [UpdateReturn] -> ShowS
show :: UpdateReturn -> String
$cshow :: UpdateReturn -> String
showsPrec :: Int -> UpdateReturn -> ShowS
$cshowsPrec :: Int -> UpdateReturn -> ShowS
Show,ReadPrec [UpdateReturn]
ReadPrec UpdateReturn
Int -> ReadS UpdateReturn
ReadS [UpdateReturn]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateReturn]
$creadListPrec :: ReadPrec [UpdateReturn]
readPrec :: ReadPrec UpdateReturn
$creadPrec :: ReadPrec UpdateReturn
readList :: ReadS [UpdateReturn]
$creadList :: ReadS [UpdateReturn]
readsPrec :: Int -> ReadS UpdateReturn
$creadsPrec :: Int -> ReadS UpdateReturn
Read,Eq UpdateReturn
UpdateReturn -> UpdateReturn -> Bool
UpdateReturn -> UpdateReturn -> Ordering
UpdateReturn -> UpdateReturn -> UpdateReturn
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UpdateReturn -> UpdateReturn -> UpdateReturn
$cmin :: UpdateReturn -> UpdateReturn -> UpdateReturn
max :: UpdateReturn -> UpdateReturn -> UpdateReturn
$cmax :: UpdateReturn -> UpdateReturn -> UpdateReturn
>= :: UpdateReturn -> UpdateReturn -> Bool
$c>= :: UpdateReturn -> UpdateReturn -> Bool
> :: UpdateReturn -> UpdateReturn -> Bool
$c> :: UpdateReturn -> UpdateReturn -> Bool
<= :: UpdateReturn -> UpdateReturn -> Bool
$c<= :: UpdateReturn -> UpdateReturn -> Bool
< :: UpdateReturn -> UpdateReturn -> Bool
$c< :: UpdateReturn -> UpdateReturn -> Bool
compare :: UpdateReturn -> UpdateReturn -> Ordering
$ccompare :: UpdateReturn -> UpdateReturn -> Ordering
Ord,Typeable)


instance ToJSON UpdateReturn where
    toJSON :: UpdateReturn -> Value
toJSON UpdateReturn
URNone = forall a. ToJSON a => a -> Value
toJSON (Text -> Value
String Text
"NONE")
    toJSON UpdateReturn
URAllOld = forall a. ToJSON a => a -> Value
toJSON (Text -> Value
String Text
"ALL_OLD")
    toJSON UpdateReturn
URUpdatedOld = forall a. ToJSON a => a -> Value
toJSON (Text -> Value
String Text
"UPDATED_OLD")
    toJSON UpdateReturn
URAllNew = forall a. ToJSON a => a -> Value
toJSON (Text -> Value
String Text
"ALL_NEW")
    toJSON UpdateReturn
URUpdatedNew = forall a. ToJSON a => a -> Value
toJSON (Text -> Value
String Text
"UPDATED_NEW")


instance Default UpdateReturn where
    def :: UpdateReturn
def = UpdateReturn
URNone



-------------------------------------------------------------------------------
-- | What to return from a 'Query' or 'Scan' query.
data QuerySelect
    = SelectSpecific [T.Text]
    -- ^ Only return selected attributes
    | SelectCount
    -- ^ Return counts instead of attributes
    | SelectProjected
    -- ^ Return index-projected attributes
    | SelectAll
    -- ^ Default. Return everything.
    deriving (QuerySelect -> QuerySelect -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuerySelect -> QuerySelect -> Bool
$c/= :: QuerySelect -> QuerySelect -> Bool
== :: QuerySelect -> QuerySelect -> Bool
$c== :: QuerySelect -> QuerySelect -> Bool
Eq,Int -> QuerySelect -> ShowS
[QuerySelect] -> ShowS
QuerySelect -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuerySelect] -> ShowS
$cshowList :: [QuerySelect] -> ShowS
show :: QuerySelect -> String
$cshow :: QuerySelect -> String
showsPrec :: Int -> QuerySelect -> ShowS
$cshowsPrec :: Int -> QuerySelect -> ShowS
Show,ReadPrec [QuerySelect]
ReadPrec QuerySelect
Int -> ReadS QuerySelect
ReadS [QuerySelect]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QuerySelect]
$creadListPrec :: ReadPrec [QuerySelect]
readPrec :: ReadPrec QuerySelect
$creadPrec :: ReadPrec QuerySelect
readList :: ReadS [QuerySelect]
$creadList :: ReadS [QuerySelect]
readsPrec :: Int -> ReadS QuerySelect
$creadsPrec :: Int -> ReadS QuerySelect
Read,Eq QuerySelect
QuerySelect -> QuerySelect -> Bool
QuerySelect -> QuerySelect -> Ordering
QuerySelect -> QuerySelect -> QuerySelect
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QuerySelect -> QuerySelect -> QuerySelect
$cmin :: QuerySelect -> QuerySelect -> QuerySelect
max :: QuerySelect -> QuerySelect -> QuerySelect
$cmax :: QuerySelect -> QuerySelect -> QuerySelect
>= :: QuerySelect -> QuerySelect -> Bool
$c>= :: QuerySelect -> QuerySelect -> Bool
> :: QuerySelect -> QuerySelect -> Bool
$c> :: QuerySelect -> QuerySelect -> Bool
<= :: QuerySelect -> QuerySelect -> Bool
$c<= :: QuerySelect -> QuerySelect -> Bool
< :: QuerySelect -> QuerySelect -> Bool
$c< :: QuerySelect -> QuerySelect -> Bool
compare :: QuerySelect -> QuerySelect -> Ordering
$ccompare :: QuerySelect -> QuerySelect -> Ordering
Ord,Typeable)


instance Default QuerySelect where def :: QuerySelect
def = QuerySelect
SelectAll

-------------------------------------------------------------------------------
querySelectJson :: KeyValue t => QuerySelect -> [t]
querySelectJson :: forall t. KeyValue t => QuerySelect -> [t]
querySelectJson (SelectSpecific [Text]
as) =
    [ Key
"Select" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"SPECIFIC_ATTRIBUTES"
    , Key
"AttributesToGet" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
as]
querySelectJson QuerySelect
SelectCount = [Key
"Select" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"COUNT"]
querySelectJson QuerySelect
SelectProjected = [Key
"Select" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ALL_PROJECTED_ATTRIBUTES"]
querySelectJson QuerySelect
SelectAll = [Key
"Select" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ALL_ATTRIBUTES"]


-------------------------------------------------------------------------------
-- | A class to help predict DynamoDb size of values, attributes and
-- entire items. The result is given in number of bytes.
class DynSize a where
    dynSize :: a -> Int

instance DynSize DValue where
    dynSize :: DValue -> Int
dynSize DValue
DNull = Int
8
    dynSize (DBool Bool
_) = Int
8
    dynSize (DBoolSet Set Bool
s) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. DynSize a => a -> Int
dynSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> DValue
DBool) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set Bool
s
    dynSize (DNum Scientific
_) = Int
8
    dynSize (DString Text
a) = Text -> Int
T.length Text
a
    dynSize (DBinary ByteString
bs) = Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base64.encode ByteString
bs
    dynSize (DNumSet Set Scientific
s) = Int
8 forall a. Num a => a -> a -> a
* forall a. Set a -> Int
S.size Set Scientific
s
    dynSize (DStringSet Set Text
s) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. DynSize a => a -> Int
dynSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DValue
DString) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set Text
s
    dynSize (DBinSet Set ByteString
s) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. DynSize a => a -> Int
dynSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DValue
DBinary) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set ByteString
s
    dynSize (DList Vector DValue
s) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. DynSize a => a -> Int
dynSize forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Vector DValue
s
    dynSize (DMap Map Text DValue
s) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. DynSize a => a -> Int
dynSize forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Map Text DValue
s

instance DynSize Attribute where
    dynSize :: Attribute -> Int
dynSize (Attribute Text
k DValue
v) = Text -> Int
T.length Text
k forall a. Num a => a -> a -> a
+ forall a. DynSize a => a -> Int
dynSize DValue
v

instance DynSize Item where
    dynSize :: Map Text DValue -> Int
dynSize Map Text DValue
m = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. DynSize a => a -> Int
dynSize forall a b. (a -> b) -> a -> b
$ Map Text DValue -> [Attribute]
attributes Map Text DValue
m

instance DynSize a => DynSize [a] where
    dynSize :: [a] -> Int
dynSize [a]
as = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. DynSize a => a -> Int
dynSize [a]
as

instance DynSize a => DynSize (Maybe a) where
    dynSize :: Maybe a -> Int
dynSize = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a. DynSize a => a -> Int
dynSize

instance (DynSize a, DynSize b) => DynSize (Either a b) where
    dynSize :: Either a b -> Int
dynSize = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. DynSize a => a -> Int
dynSize forall a. DynSize a => a -> Int
dynSize


-------------------------------------------------------------------------------
-- | Will an attribute be considered empty by DynamoDb?
--
-- A 'PutItem' (or similar) with empty attributes will be rejected
-- with a 'ValidationException'.
nullAttr :: Attribute -> Bool
nullAttr :: Attribute -> Bool
nullAttr (Attribute Text
_ DValue
val) =
    case DValue
val of
      DString Text
"" -> Bool
True
      DBinary ByteString
"" -> Bool
True
      DNumSet Set Scientific
s | forall a. Set a -> Bool
S.null Set Scientific
s -> Bool
True
      DStringSet Set Text
s | forall a. Set a -> Bool
S.null Set Text
s -> Bool
True
      DBinSet Set ByteString
s | forall a. Set a -> Bool
S.null Set ByteString
s -> Bool
True
      DValue
_ -> Bool
False




-------------------------------------------------------------------------------
--
-- | Item Parsing
--
-------------------------------------------------------------------------------



-- | Failure continuation.
type Failure f r   = String -> f r

-- | Success continuation.
type Success a f r = a -> f r


-- | A continuation-based parser type.
newtype Parser a = Parser {
      forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
runParser :: forall f r.
                   Failure f r
                -> Success a f r
                -> f r
    }

instance Monad Parser where
    Parser a
m >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
g = forall a.
(forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure f r
kf Success b f r
ks -> let ks' :: a -> f r
ks' a
a = forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
runParser (a -> Parser b
g a
a) Failure f r
kf Success b f r
ks
                                 in forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
runParser Parser a
m Failure f r
kf a -> f r
ks'
    {-# INLINE (>>=) #-}
    return :: forall a. a -> Parser a
return a
a = forall a.
(forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure f r
_kf Success a f r
ks -> Success a f r
ks a
a
    {-# INLINE return #-}
#if !(MIN_VERSION_base(4,13,0))
    fail msg = Parser $ \kf _ks -> kf msg
    {-# INLINE fail #-}
#endif

#if MIN_VERSION_base(4,9,0)
instance Fail.MonadFail Parser where
    fail :: forall a. String -> Parser a
fail String
msg = forall a.
(forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure f r
kf Success a f r
_ks -> Failure f r
kf String
msg
    {-# INLINE fail #-}
#endif

instance Functor Parser where
    fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f Parser a
m = forall a.
(forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure f r
kf Success b f r
ks -> let ks' :: a -> f r
ks' a
a = Success b f r
ks (a -> b
f a
a)
                                  in forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
runParser Parser a
m Failure f r
kf a -> f r
ks'
    {-# INLINE fmap #-}

instance Applicative Parser where
    pure :: forall a. a -> Parser a
pure  = forall (m :: * -> *) a. Monad m => a -> m a
return
    {-# INLINE pure #-}
    <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
(<*>) = forall a b. Parser (a -> b) -> Parser a -> Parser b
apP
    {-# INLINE (<*>) #-}

instance Alternative Parser where
    empty :: forall a. Parser a
empty = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty"
    {-# INLINE empty #-}
    <|> :: forall a. Parser a -> Parser a -> Parser a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
    {-# INLINE (<|>) #-}

instance MonadPlus Parser where
    mzero :: forall a. Parser a
mzero = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mzero"
    {-# INLINE mzero #-}
    mplus :: forall a. Parser a -> Parser a -> Parser a
mplus Parser a
a Parser a
b = forall a.
(forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure f r
kf Success a f r
ks -> let kf' :: Failure f r
kf' String
_ = forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
runParser Parser a
b Failure f r
kf Success a f r
ks
                                   in forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
runParser Parser a
a Failure f r
kf' Success a f r
ks
    {-# INLINE mplus #-}

instance Sem.Semigroup (Parser a) where
    <> :: Parser a -> Parser a -> Parser a
(<>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
    {-# INLINE (<>) #-}

instance Monoid (Parser a) where
    mempty :: Parser a
mempty  = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mempty"
    {-# INLINE mempty #-}
    mappend :: Parser a -> Parser a -> Parser a
mappend = forall a. Semigroup a => a -> a -> a
(Sem.<>)
    {-# INLINE mappend #-}

apP :: Parser (a -> b) -> Parser a -> Parser b
apP :: forall a b. Parser (a -> b) -> Parser a -> Parser b
apP Parser (a -> b)
d Parser a
e = do
  a -> b
b <- Parser (a -> b)
d
  a
a <- Parser a
e
  forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
b a
a)
{-# INLINE apP #-}


-------------------------------------------------------------------------------
-- | Types convertible to DynamoDb 'Item' collections.
--
-- Use 'attr' and 'attrAs' combinators to conveniently define instances.
class ToDynItem a where
    toItem :: a -> Item


-------------------------------------------------------------------------------
-- | Types parseable from DynamoDb 'Item' collections.
--
-- User 'getAttr' family of functions to applicatively or monadically
-- parse into your custom types.
class FromDynItem a where
    parseItem :: Item -> Parser a


instance ToDynItem Item where toItem :: Map Text DValue -> Map Text DValue
toItem = forall a. a -> a
id

instance FromDynItem Item where parseItem :: Map Text DValue -> Parser (Map Text DValue)
parseItem = forall (m :: * -> *) a. Monad m => a -> m a
return


instance DynVal a => ToDynItem [(T.Text, a)] where
    toItem :: [(Text, a)] -> Map Text DValue
toItem [(Text, a)]
as = [Attribute] -> Map Text DValue
item forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. DynVal a => Text -> a -> Attribute
attr) [(Text, a)]
as

instance (Typeable a, DynVal a) => FromDynItem [(T.Text, a)] where
    parseItem :: Map Text DValue -> Parser [(Text, a)]
parseItem Map Text DValue
i = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, DValue) -> Parser (Text, a)
f forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Text DValue
i
        where
          f :: (Text, DValue) -> Parser (Text, a)
f (Text
k,DValue
v) = do
              a
v' <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Typeable a => Tagged a DValue -> String
valErr (forall {k} (s :: k) b. b -> Tagged s b
Tagged DValue
v :: Tagged a DValue))) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                    forall a. DynVal a => DValue -> Maybe a
fromValue DValue
v
              forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k, a
v')


instance DynVal a => ToDynItem (M.Map T.Text a) where
    toItem :: Map Text a -> Map Text DValue
toItem Map Text a
m = forall a. ToDynItem a => a -> Map Text DValue
toItem forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Text a
m


instance (Typeable a, DynVal a) => FromDynItem (M.Map T.Text a) where
    parseItem :: Map Text DValue -> Parser (Map Text a)
parseItem Map Text DValue
i = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromDynItem a => Map Text DValue -> Parser a
parseItem Map Text DValue
i


valErr :: forall a. Typeable a => Tagged a DValue -> String
valErr :: forall a. Typeable a => Tagged a DValue -> String
valErr (Tagged DValue
dv) = String
"Can't convert DynamoDb value " forall a. Semigroup a => a -> a -> a
Sem.<> forall a. Show a => a -> String
show DValue
dv forall a. Semigroup a => a -> a -> a
Sem.<>
              String
" into type " forall a. Semigroup a => a -> a -> a
Sem.<> (forall a. Show a => a -> String
show (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: a)))


-- | Convenience combinator for parsing fields from an 'Item' returned
-- by DynamoDb.
getAttr
    :: forall a. (Typeable a, DynVal a)
    => T.Text
    -- ^ Attribute name
    -> Item
    -- ^ Item from DynamoDb
    -> Parser a
getAttr :: forall a.
(Typeable a, DynVal a) =>
Text -> Map Text DValue -> Parser a
getAttr Text
k Map Text DValue
m = do
    case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
k Map Text DValue
m of
      Maybe DValue
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Key " forall a. Semigroup a => a -> a -> a
Sem.<> Text -> String
T.unpack Text
k forall a. Semigroup a => a -> a -> a
Sem.<> String
" not found")
      Just DValue
dv -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Typeable a => Tagged a DValue -> String
valErr (forall {k} (s :: k) b. b -> Tagged s b
Tagged DValue
dv :: Tagged a DValue))) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. DynVal a => DValue -> Maybe a
fromValue DValue
dv


-- | Parse attribute if it's present in the 'Item'. Fail if attribute
-- is present but conversion fails.
getAttr'
    :: forall a. (DynVal a)
    => T.Text
    -- ^ Attribute name
    -> Item
    -- ^ Item from DynamoDb
    -> Parser (Maybe a)
getAttr' :: forall a. DynVal a => Text -> Map Text DValue -> Parser (Maybe a)
getAttr' Text
k Map Text DValue
m = do
    case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
k Map Text DValue
m of
      Maybe DValue
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Just DValue
dv -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. DynVal a => DValue -> Maybe a
fromValue DValue
dv

-- | Combinator for parsing an attribute into a 'FromDynItem'.
parseAttr
    :: FromDynItem a
    => T.Text
    -- ^ Attribute name
    -> Item
    -- ^ Item from DynamoDb
    -> Parser a
parseAttr :: forall a. FromDynItem a => Text -> Map Text DValue -> Parser a
parseAttr Text
k Map Text DValue
m =
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
k Map Text DValue
m of
    Maybe DValue
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Key " forall a. Semigroup a => a -> a -> a
Sem.<> Text -> String
T.unpack Text
k forall a. Semigroup a => a -> a -> a
Sem.<> String
" not found")
    Just (DMap Map Text DValue
dv) -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"...")) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. FromDynItem a => Map Text DValue -> Either String a
fromItem Map Text DValue
dv
    Maybe DValue
_       -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Key " forall a. Semigroup a => a -> a -> a
Sem.<> Text -> String
T.unpack Text
k forall a. Semigroup a => a -> a -> a
Sem.<> String
" is not a map!")

-------------------------------------------------------------------------------
-- | Parse an 'Item' into target type using the 'FromDynItem'
-- instance.
fromItem :: FromDynItem a => Item -> Either String a
fromItem :: forall a. FromDynItem a => Map Text DValue -> Either String a
fromItem Map Text DValue
i = forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
runParser (forall a. FromDynItem a => Map Text DValue -> Parser a
parseItem Map Text DValue
i) forall a b. a -> Either a b
Left forall a b. b -> Either a b
Right