module Aws.Kinesis.Types
( StreamName
, streamName
, streamNameText
, ShardId
, SequenceNumber
, PartitionHash
, partitionHash
, partitionHashInteger
, PartitionKey
, partitionKey
, partitionKeyText
, ShardIterator
, ShardIteratorType(..)
, Record(..)
, StreamDescription(..)
, StreamStatus(..)
, Shard(..)
) where
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif
import Aws.General
#if ! MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.DeepSeq
import Data.Aeson
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import Data.Monoid
import Data.String
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Read as T
import Data.Typeable
import GHC.Generics
import Test.QuickCheck
import Test.QuickCheck.Instances ()
sshow :: (Show a, IsString b) => a -> b
sshow = fromString . show
tryM :: Monad m => Either T.Text a -> m a
tryM = either (fail . T.unpack) return
newtype StreamName = StreamName { streamNameText :: T.Text }
deriving (Show, Read, Eq, Ord, Typeable, Generic)
instance NFData StreamName
streamName :: T.Text -> Either T.Text StreamName
streamName t
| T.length t < 1 = Left $ "Illegal StreamName " <> sshow t <> "; StreamName must be of length at least 1"
| T.length t > 128 = Left $ "Illegal StreamName " <> sshow t <> "; StreamName must be of length at most 128"
| otherwise = Right $ StreamName t
instance IsString StreamName where
fromString = either (error . T.unpack) id . streamName . T.pack
instance ToJSON StreamName where
toJSON = toJSON . streamNameText
instance FromJSON StreamName where
parseJSON = withText "StreamName" $ tryM . streamName
instance Arbitrary StreamName where
arbitrary = StreamName . T.pack <$> (resize 128 . listOf1 $ elements chars)
where
chars = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9'] <> "_.-"
newtype ShardId = ShardId { shardIdText :: T.Text }
deriving (Show, Read, Eq, Ord, Typeable, Generic)
instance NFData ShardId
instance ToJSON ShardId where
toJSON = toJSON . shardIdText
instance FromJSON ShardId where
parseJSON = withText "ShardId" $ return . ShardId
instance Arbitrary ShardId where
arbitrary = ShardId <$> (resize 128 arbitrary `suchThat` (not . T.null))
newtype SequenceNumber = SequenceNumber { sequenceNumberText :: T.Text }
deriving (Show, Read, Eq, Ord, Typeable, Generic)
instance NFData SequenceNumber
instance ToJSON SequenceNumber where
toJSON = toJSON . sequenceNumberText
instance FromJSON SequenceNumber where
parseJSON = withText "SequenceNumber" $ return . SequenceNumber
instance Arbitrary SequenceNumber where
arbitrary = SequenceNumber . T.pack . show . getPositive
<$> (arbitrary :: Gen (Positive Integer))
newtype PartitionHash = PartitionHash { partitionHashInteger :: Integer }
deriving (Show, Read, Eq, Ord, Typeable, Generic)
instance NFData PartitionHash
partitionHash :: Integer -> Either T.Text PartitionHash
partitionHash i
| i >= 2^(128 :: Int) = Left $ "partition hash " <> sshow i <> "is out of range; a partition hash must be a 128 bit unsigned integer"
| i < 0 = Left $ "partition hash " <> sshow i <> "is out of range; a partition hash must be a 128 bit unsigned integer"
| otherwise = Right $ PartitionHash i
instance ToJSON PartitionHash where
toJSON = toJSON . show . partitionHashInteger
instance FromJSON PartitionHash where
parseJSON = withText "PartitionHash" $ \t -> case T.decimal t of
Right (a, "") -> tryM $ partitionHash a
Right (_, x) -> fail $ "trailing text: " <> T.unpack x
Left e -> fail e
instance Arbitrary PartitionHash where
arbitrary = PartitionHash . getPositive <$> resize (2^(128 :: Int) 1) arbitrary
newtype PartitionKey = PartitionKey { partitionKeyText :: T.Text }
deriving (Show, Read, Eq, Ord, IsString, Typeable, Generic)
instance NFData PartitionKey
partitionKey :: T.Text -> Either T.Text PartitionKey
partitionKey t
| T.length t < 1 = Left $ "Illegal PartitionKey " <> sshow t <> "; PartitionKey must be of length at least 1"
| T.length t > 256 = Left $ "Illegal PartitionKey " <> sshow t <> "; PartitionKey must be of length at most 256"
| otherwise = Right $ PartitionKey t
instance ToJSON PartitionKey where
toJSON = toJSON . partitionKeyText
instance FromJSON PartitionKey where
parseJSON = withText "PartitionKey" $ tryM . partitionKey
instance Arbitrary PartitionKey where
arbitrary = PartitionKey
<$> (resize 256 arbitrary `suchThat` (not . T.null))
newtype ShardIterator = ShardIterator { shardIteratorText :: T.Text }
deriving (Show, Read, Eq, Ord, Typeable, Generic)
instance NFData ShardIterator
shardIterator :: T.Text -> Either T.Text ShardIterator
shardIterator t
| T.length t < 1 = Left $ "Illegal ShardIterator " <> sshow t <> "; ShardIterator must be of length at least 1"
| T.length t > 512 = Left $ "Illegal ShardIterator " <> sshow t <> "; ShardIterator must be of length at most 512"
| otherwise = Right $ ShardIterator t
instance ToJSON ShardIterator where
toJSON = toJSON . shardIteratorText
instance FromJSON ShardIterator where
parseJSON = withText "ShardIterator" $ tryM . shardIterator
instance Arbitrary ShardIterator where
arbitrary = ShardIterator
<$> (resize 512 arbitrary `suchThat` (not . T.null))
data ShardIteratorType
= AtSequenceNumber
| AfterSequenceNumber
| TrimHorizon
| Latest
deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable, Generic)
instance NFData ShardIteratorType
instance ToJSON ShardIteratorType where
toJSON AtSequenceNumber = "AT_SEQUENCE_NUMBER"
toJSON AfterSequenceNumber = "AFTER_SEQUENCE_NUMBER"
toJSON TrimHorizon = "TRIM_HORIZON"
toJSON Latest = "LATEST"
instance FromJSON ShardIteratorType where
parseJSON = withText "SharedIteratorType" $ \t -> case t of
"AT_SEQUENCE_NUMBER" -> return AtSequenceNumber
"AFTER_SEQUENCE_NUMBER" -> return AfterSequenceNumber
"TRIM_HORIZON" -> return TrimHorizon
"LATEST" -> return Latest
e -> fail $ "unexpected value for SharedIteratorType: " <> T.unpack e
instance Arbitrary ShardIteratorType where
arbitrary = elements [minBound .. maxBound]
data Record = Record
{ recordData :: !B.ByteString
, recordPartitionKey :: !PartitionKey
, recordSequenceNumber :: !SequenceNumber
}
deriving (Show, Read, Eq, Ord, Typeable, Generic)
instance NFData Record
instance ToJSON Record where
toJSON Record{..} = object
[ "Data" .= T.decodeUtf8 (B64.encode recordData)
, "PartitionKey" .= recordPartitionKey
, "SequenceNumber" .= recordSequenceNumber
]
instance FromJSON Record where
parseJSON = withObject "Record" $ \o -> Record
<$> (from64 =<< o .: "Data")
<*> o .: "PartitionKey"
<*> o .: "SequenceNumber"
where
from64 x = case B64.decode (T.encodeUtf8 x) of
Left e -> fail $ "failed to decode base64 encoded data: " <> e
Right a -> return a
instance Arbitrary Record where
arbitrary = Record
<$> (arbitrary `suchThat` ((<= 51200) . B.length))
<*> arbitrary
<*> arbitrary
data StreamDescription = StreamDescription
{ streamDescriptionHasMoreShards :: !Bool
, streamDescriptionShards :: ![Shard]
, streamDescriptionStreamARN :: !Arn
, streamDescriptionStreamName :: !StreamName
, streamDescriptionStreamStatus :: !StreamStatus
}
deriving (Show, Read, Eq, Ord, Typeable, Generic)
instance NFData StreamDescription
instance ToJSON StreamDescription where
toJSON StreamDescription{..} = object
[ "HasMoreShards" .= streamDescriptionHasMoreShards
, "Shards" .= streamDescriptionShards
, "StreamARN" .= streamDescriptionStreamARN
, "StreamName" .= streamDescriptionStreamName
, "StreamStatus" .= streamDescriptionStreamStatus
]
instance FromJSON StreamDescription where
parseJSON = withObject "StreamDescription" $ \o -> StreamDescription
<$> o .: "HasMoreShards"
<*> o .: "Shards"
<*> o .: "StreamARN"
<*> o .: "StreamName"
<*> o .: "StreamStatus"
instance Arbitrary StreamDescription where
arbitrary = StreamDescription
<$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
data StreamStatus
= StreamStatusCreating
| StreamStatusDeleting
| StreamStatusActive
| StreamStatusUpdating
deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable, Generic)
instance NFData StreamStatus
instance ToJSON StreamStatus where
toJSON StreamStatusCreating = "CREATING"
toJSON StreamStatusDeleting = "DELETING"
toJSON StreamStatusActive = "ACTIVE"
toJSON StreamStatusUpdating = "UPDATING"
instance FromJSON StreamStatus where
parseJSON = withText "StreamStatus" $ \t -> case t of
"CREATING" -> return StreamStatusCreating
"DELETING" -> return StreamStatusDeleting
"ACTIVE" -> return StreamStatusActive
"UPDATING" -> return StreamStatusUpdating
e -> fail $ "unexpected value for StreamStatus: " <> T.unpack e
instance Arbitrary StreamStatus where
arbitrary = elements [minBound .. maxBound]
data Shard = Shard
{ shardAdjacentParentShardId :: !(Maybe ShardId)
, shardHashKeyRange :: !(PartitionHash, PartitionHash)
, shardParentShardId :: !(Maybe ShardId)
, shardSequenceNumberRange :: !(SequenceNumber, Maybe SequenceNumber)
, shardShardId :: ShardId
}
deriving (Show, Read, Eq, Ord, Typeable, Generic)
instance NFData Shard
instance ToJSON Shard where
toJSON Shard{..} = object
[ "AdjacentParentShardId" .= shardAdjacentParentShardId
, "HashKeyRange" .= object
[ "StartingHashKey" .= fst shardHashKeyRange
, "EndingHashKey" .= snd shardHashKeyRange
]
, "ParentShardId" .= shardParentShardId
, "SequenceNumberRange" .= object
[ "StartingSequenceNumber" .= fst shardSequenceNumberRange
, "EndingSequenceNumber" .= snd shardSequenceNumberRange
]
, "ShardId" .= shardShardId
]
instance FromJSON Shard where
parseJSON = withObject "Shard" $ \o -> Shard
<$> o .:? "AdjacentParentShardId" .!= Nothing
<*> (hashKeyRange =<< o .: "HashKeyRange")
<*> o .:? "ParentShardId" .!= Nothing
<*> (sequenceNumberRange =<< o .: "SequenceNumberRange")
<*> o .: "ShardId"
where
hashKeyRange = withObject "HashKeyRange" $ \o -> (,)
<$> o .: "StartingHashKey"
<*> o .: "EndingHashKey"
sequenceNumberRange = withObject "SequenceNumberRange" $ \o -> (,)
<$> o .: "StartingSequenceNumber"
<*> o .:? "EndingSequenceNumber" .!= Nothing
instance Arbitrary Shard where
arbitrary = Shard
<$> arbitrary
<*> do
u <- arbitrary
l <- resize (fromIntegral $ partitionHashInteger u) arbitrary
return (l,u)
<*> arbitrary
<*> do
u <- arbitrary
l <- resize (maybe maxBound (read . T.unpack . sequenceNumberText) u) arbitrary
return (l,u)
<*> arbitrary