diff --git a/rds-data.cabal b/rds-data.cabal --- a/rds-data.cabal +++ b/rds-data.cabal @@ -1,7 +1,7 @@ cabal-version: 3.6 name: rds-data -version: 0.0.0.8 +version: 0.0.0.9 synopsis: Codecs for use with AWS rds-data description: Codecs for use with AWS rds-data. category: Data @@ -39,10 +39,10 @@ common hedgehog { build-depends: hedgehog >= 1.4 && < 2 } common hedgehog-extras { build-depends: hedgehog-extras >= 0.6.0.2 && < 0.7 } common http-client { build-depends: http-client >= 0.5.14 && < 0.8 } -common hw-polysemy-amazonka { build-depends: hw-polysemy:amazonka >= 0.2.14.6 && < 0.3 } -common hw-polysemy-core { build-depends: hw-polysemy:core >= 0.2.14.6 && < 0.3 } -common hw-polysemy-hedgehog { build-depends: hw-polysemy:hedgehog >= 0.2.14.6 && < 0.3 } -common hw-polysemy-testcontainers-localstack { build-depends: hw-polysemy:testcontainers-localstack >= 0.2.14.6 && < 0.3 } +common hw-polysemy-amazonka { build-depends: hw-polysemy:amazonka >= 0.2.14.7 && < 0.3 } +common hw-polysemy-core { build-depends: hw-polysemy:core >= 0.2.14.7 && < 0.3 } +common hw-polysemy-hedgehog { build-depends: hw-polysemy:hedgehog >= 0.2.14.7 && < 0.3 } +common hw-polysemy-testcontainers-localstack { build-depends: hw-polysemy:testcontainers-localstack >= 0.2.14.7 && < 0.3 } common microlens { build-depends: microlens >= 0.4.13 && < 0.5 } common mtl { build-depends: mtl >= 2 && < 3 } common optparse-applicative { build-depends: optparse-applicative >= 0.18.1.0 && < 0.19 } @@ -87,6 +87,7 @@ , amazonka-rds , amazonka-rds-data , amazonka-secretsmanager + , base64-bytestring , bytestring , contravariant , generic-lens diff --git a/src/Data/RdsData/Decode/Row.hs b/src/Data/RdsData/Decode/Row.hs --- a/src/Data/RdsData/Decode/Row.hs +++ b/src/Data/RdsData/Decode/Row.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module Data.RdsData.Decode.Row ( DecodeRow(..) @@ -23,6 +23,8 @@ , word64 , bytestring , lazyBytestring + , base64Text + , lazyBase64Text , timeOfDay , day , ulid @@ -36,20 +38,20 @@ , decodeRows ) where -import Control.Monad.Except -import Control.Monad.State -import Data.ByteString (ByteString) -import Control.Monad -import Data.Functor.Identity ( Identity ) -import Data.Int -import Data.RdsData.Decode.Value (DecodeValue) -import Data.RdsData.Types.Value -import Data.Text -import Data.Time -import Data.ULID (ULID) -import Data.UUID (UUID) -import Data.Word -import Prelude hiding (maybe) +import Control.Monad +import Control.Monad.Except +import Control.Monad.State +import Data.ByteString (ByteString) +import Data.Functor.Identity (Identity) +import Data.Int +import Data.RdsData.Decode.Value (DecodeValue) +import Data.RdsData.Types.Value +import Data.Text +import Data.Time +import Data.ULID (ULID) +import Data.UUID (UUID) +import Data.Word +import Prelude hiding (maybe) import qualified Data.Aeson as J import qualified Data.ByteString.Lazy as LBS @@ -84,7 +86,7 @@ decodeRowValue decoder v = case DV.decodeValue decoder v of Right a -> pure a - Left e -> throwError $ "Failed to decode Value: " <> e + Left e -> throwError $ "Failed to decode Value: " <> e column :: () => DecodeValue a @@ -167,6 +169,14 @@ lazyBytestring = column DV.lazyBytestring +base64Text :: DecodeRow ByteString +base64Text = + column DV.base64Text + +lazyBase64Text :: DecodeRow LBS.ByteString +lazyBase64Text = + column DV.lazyBase64Text + string :: DecodeRow String string = column DV.string @@ -179,35 +189,35 @@ timeOfDay = do t <- text case parseTimeM True defaultTimeLocale "%H:%M:%S%Q" (T.unpack t) of - Just a -> pure a + Just a -> pure a Nothing -> throwError $ "Failed to parse TimeOfDay: " <> T.pack (show t) ulid :: DecodeRow ULID ulid = do t <- text case CONV.textToUlid t of - Right a -> pure a + Right a -> pure a Left msg -> throwError $ "Failed to parse ULID: " <> msg utcTime :: DecodeRow UTCTime utcTime = do t <- text case parseTimeM True defaultTimeLocale "%Y-%m-%d %H:%M:%S" (T.unpack t) of - Just a -> pure a + Just a -> pure a Nothing -> throwError $ "Failed to parse UTCTime: " <> T.pack (show t) uuid :: DecodeRow UUID uuid = do t <- text case UUID.fromString (T.unpack t) of - Just a -> pure a + Just a -> pure a Nothing -> throwError $ "Failed to parse UUID: " <> T.pack (show t) day :: DecodeRow Day day = do t <- text case parseTimeM True defaultTimeLocale "%Y-%m-%d" (T.unpack t) of - Just a -> pure a + Just a -> pure a Nothing -> throwError $ "Failed to parse Day: " <> T.pack (show t) ignore :: DecodeRow () diff --git a/src/Data/RdsData/Decode/Value.hs b/src/Data/RdsData/Decode/Value.hs --- a/src/Data/RdsData/Decode/Value.hs +++ b/src/Data/RdsData/Decode/Value.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} {- HLINT ignore "Use <&>" -} @@ -32,6 +32,8 @@ , bytestring , lazyText , lazyBytestring + , base64Text + , lazyBase64Text , string , json , timeOfDay @@ -41,28 +43,31 @@ ) where -import Amazonka.Data.Base64 -import Control.Applicative -import Data.ByteString (ByteString) -import Data.Int -import Data.RdsData.Decode.Array (DecodeArray(..)) -import Data.RdsData.Internal.Aeson -import Data.RdsData.Types.Value -import Data.Text (Text) -import Data.Time -import Data.UUID (UUID) -import Data.Word -import Prelude hiding (maybe, null) +import Amazonka.Data.Base64 +import Control.Applicative +import Data.ByteString (ByteString) +import Data.Int +import Data.RdsData.Decode.Array (DecodeArray (..)) +import Data.RdsData.Internal.Aeson +import Data.RdsData.Types.Value +import Data.Text (Text) +import Data.Time +import Data.UUID (UUID) +import Data.Word +import Prelude hiding (maybe, null) -import qualified Amazonka.Data.ByteString as AWS -import qualified Data.Aeson as J -import qualified Data.ByteString.Lazy as LBS -import qualified Data.RdsData.Internal.Convert as CONV -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.Lazy as LT -import qualified Data.UUID as UUID -import qualified Prelude as P +import qualified Amazonka.Data.ByteString as AWS +import qualified Data.Aeson as J +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Base64.Lazy as LB64 +import qualified Data.ByteString.Lazy as LBS +import qualified Data.RdsData.Internal.Convert as CONV +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.Encoding as LT +import qualified Data.UUID as UUID +import qualified Prelude as P newtype DecodeValue a = DecodeValue { decodeValue :: Value -> Either Text a @@ -106,7 +111,7 @@ DecodeValue \v -> case v of ValueOfNull -> Right Nothing - _ -> Just <$> f v + _ -> Just <$> f v -------------------------------------------------------------------------------- @@ -129,7 +134,7 @@ DecodeValue \v -> case v of ValueOfBool b -> Right b - _ -> Left $ decodeValueFailedMessage "bool" "Bool" Nothing v + _ -> Left $ decodeValueFailedMessage "bool" "Bool" Nothing v double :: DecodeValue Double double = @@ -147,7 +152,7 @@ DecodeValue \v -> case v of ValueOfText s -> Right s - _ -> Left $ decodeValueFailedMessage "text" "Text" Nothing v + _ -> Left $ decodeValueFailedMessage "text" "Text" Nothing v integer :: DecodeValue Integer integer = @@ -161,7 +166,7 @@ DecodeValue \v -> case v of ValueOfNull -> Right () - _ -> Left $ decodeValueFailedMessage "null" "()" Nothing v + _ -> Left $ decodeValueFailedMessage "null" "()" Nothing v -------------------------------------------------------------------------------- @@ -243,6 +248,22 @@ lazyText = LT.fromStrict <$> text +base64Text :: DecodeValue ByteString +base64Text = do + t <- text + let b64 = T.encodeUtf8 t + case B64.decode b64 of + Right a -> pure a + Left e -> decodeValueFailed "base64-text" "Text" (Just (T.pack e)) + +lazyBase64Text :: DecodeValue LBS.ByteString +lazyBase64Text = do + t <- lazyText + let b64 = LT.encodeUtf8 t + case LB64.decode b64 of + Right a -> pure a + Left e -> decodeValueFailed "base64-text" "Text" (Just (T.pack e)) + lazyBytestring :: DecodeValue LBS.ByteString lazyBytestring = LBS.fromStrict <$> bytestring @@ -256,7 +277,7 @@ t <- text case J.eitherDecode (LBS.fromStrict (T.encodeUtf8 t)) of Right v -> pure v - Left e -> decodeValueFailed "json" "Value" (Just (T.pack e)) + Left e -> decodeValueFailed "json" "Value" (Just (T.pack e)) timeOfDay :: DecodeValue TimeOfDay timeOfDay = do @@ -269,19 +290,19 @@ utcTime = do t <- text case parseTimeM True defaultTimeLocale "%Y-%m-%d %H:%M:%S" (T.unpack t) of - Just a -> pure a + Just a -> pure a Nothing -> decodeValueFailed "utcTime" "UTCTime" Nothing uuid :: DecodeValue UUID uuid = do t <- text case UUID.fromString (T.unpack t) of - Just a -> pure a + Just a -> pure a Nothing -> decodeValueFailed "uuid" "UUID" Nothing day :: DecodeValue Day day = do t <- text case parseTimeM True defaultTimeLocale "%Y-%m-%d" (T.unpack t) of - Just a -> pure a + Just a -> pure a Nothing -> decodeValueFailed "day" "Day" Nothing diff --git a/src/Data/RdsData/Default.hs b/src/Data/RdsData/Default.hs --- a/src/Data/RdsData/Default.hs +++ b/src/Data/RdsData/Default.hs @@ -7,4 +7,4 @@ import Data.Text projectDefaultLocalStack :: Text -projectDefaultLocalStack = "localstack/localstack-pro:3.7.2" +projectDefaultLocalStack = "localstack/localstack-pro:latest" diff --git a/src/Data/RdsData/Encode/Param.hs b/src/Data/RdsData/Encode/Param.hs --- a/src/Data/RdsData/Encode/Param.hs +++ b/src/Data/RdsData/Encode/Param.hs @@ -31,6 +31,8 @@ , int8 , json , lazyBytestring + , base64Text + , lazyBase64Text , lazyText , timeOfDay , ulid @@ -62,9 +64,13 @@ import qualified Amazonka.Data.Base64 as AWS import qualified Amazonka.RDSData as AWS import qualified Data.Aeson as J +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Base64.Lazy as LB64 import qualified Data.ByteString.Lazy as LBS import qualified Data.RdsData.Internal.Convert as CONV +import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.Encoding as LT import qualified Prelude as P newtype EncodeParam a = EncodeParam @@ -178,6 +184,14 @@ lazyBytestring :: EncodeParam LBS.ByteString lazyBytestring = LBS.toStrict >$< bytestring + +base64Text :: EncodeParam ByteString +base64Text = + (T.decodeUtf8 . B64.encode) >$< text + +lazyBase64Text :: EncodeParam LBS.ByteString +lazyBase64Text = + (LT.decodeUtf8 . LB64.encode) >$< lazyText timeOfDay :: EncodeParam TimeOfDay timeOfDay = diff --git a/src/Data/RdsData/Encode/Params.hs b/src/Data/RdsData/Encode/Params.hs --- a/src/Data/RdsData/Encode/Params.hs +++ b/src/Data/RdsData/Encode/Params.hs @@ -26,6 +26,8 @@ , int64 , json , lazyBytestring + , base64Text + , lazyBase64Text , lazyText , timeOfDay , ulid @@ -38,27 +40,27 @@ , word64 ) where -import Data.ByteString (ByteString) -import Data.Functor.Contravariant -import Data.Functor.Contravariant.Divisible -import Data.Int -import Data.RdsData.Encode.Array (EncodeArray(..)) -import Data.RdsData.Encode.Param (EncodeParam(..)) -import Data.RdsData.Types.Param -import Data.Text (Text) -import Data.Time -import Data.UUID (UUID) -import Data.ULID (ULID) -import Data.Void -import Data.Word -import Prelude hiding (maybe, null) +import Data.ByteString (ByteString) +import Data.Functor.Contravariant +import Data.Functor.Contravariant.Divisible +import Data.Int +import Data.RdsData.Encode.Array (EncodeArray (..)) +import Data.RdsData.Encode.Param (EncodeParam (..)) +import Data.RdsData.Types.Param +import Data.Text (Text) +import Data.Time +import Data.ULID (ULID) +import Data.UUID (UUID) +import Data.Void +import Data.Word +import Prelude hiding (maybe, null) -import qualified Amazonka.Data.Base64 as AWS -import qualified Data.Aeson as J -import qualified Data.ByteString.Lazy as LBS -import qualified Data.RdsData.Encode.Param as EP -import qualified Data.Text.Lazy as LT -import qualified Prelude as P +import qualified Amazonka.Data.Base64 as AWS +import qualified Data.Aeson as J +import qualified Data.ByteString.Lazy as LBS +import qualified Data.RdsData.Encode.Param as EP +import qualified Data.Text.Lazy as LT +import qualified Prelude as P newtype EncodeParams a = EncodeParams { encodeParams :: a -> [Param] -> [Param] @@ -80,7 +82,7 @@ choose f (EncodeParams g) (EncodeParams h) = EncodeParams \a -> case f a of - Left b -> g b + Left b -> g b Right c -> h c lose f = EncodeParams $ absurd . f @@ -186,6 +188,14 @@ lazyBytestring :: EncodeParams LBS.ByteString lazyBytestring = column EP.lazyBytestring + +base64Text :: EncodeParams ByteString +base64Text = + column EP.base64Text + +lazyBase64Text :: EncodeParams LBS.ByteString +lazyBase64Text = + column EP.lazyBase64Text timeOfDay :: EncodeParams TimeOfDay timeOfDay =