module Data.TCache.AWS (
amazonSDBPersist,
amazonS3Persist,
) where
import Aws
import Aws.SimpleDb hiding (select)
import qualified Data.Text as T
import Data.Text.Encoding
import Data.ByteString.Lazy.Char8(toChunks,fromChunks,pack,unpack)
import Network
import Aws.S3
import Data.Conduit
import Network.HTTP.Conduit
import qualified Data.Conduit.List as CList
import Data.List as L hiding (delete)
import Data.Maybe
import System.IO.Unsafe
import Control.Exception
import Control.Monad
import Data.TCache.Defs
import Data.String
sdbCfg = defServiceConfig
amazonSDBPersist :: T.Text -> Bool -> Persist
amazonSDBPersist domain delete= unsafePerformIO $ withSocketsDo $ do
cfg <- baseConfiguration
when delete $ simpleAws cfg sdbCfg (deleteDomain domain) >> return()
simpleAws cfg sdbCfg $ createDomain domain
return $ _amazonSDBPersist cfg domain
_amazonSDBPersist cfg domain = Persist{
readByKey= \key -> withSocketsDo $ do
r <- simpleAws cfg sdbCfg $ getAttributes (T.pack key) domain
case r of
GetAttributesResponse [ForAttribute _ text] -> return $ Just $ fromChunks [encodeUtf8 text]
_ -> return Nothing,
write= \key str -> withSocketsDo $ do
simpleAws cfg sdbCfg
$ putAttributes (T.pack key) [ForAttribute tdata (SetAttribute (T.concat $ map decodeUtf8 $ toChunks str) True)] domain
return (),
delete= \ key -> withSocketsDo $ do
simpleAws cfg sdbCfg $ deleteAttributes (T.pack key) [ForAttribute tdata DeleteAttribute] domain
return ()
}
s3cfg = Aws.defServiceConfig :: S3Configuration Aws.NormalQuery
tdata= "textdata"
deriving instance Show GetObjectResponse
instance Show (ResumableSource a b) where show _= "source"
amazonS3Persist :: Bucket -> Persist
amazonS3Persist bucket= unsafePerformIO $ withSocketsDo $ do
cfg <- baseConfiguration
return $ _amazonS3Persist cfg bucket
_amazonS3Persist cfg bucket= Persist{
readByKey = \key -> (withSocketsDo $ withManager $ \mgr -> do
mr <- do
o@(GetObjectResponse hdr rsp) <-
Aws.pureAws cfg s3cfg mgr
$ getObject
bucket
(fromString key)
if omDeleteMarker hdr
then return Nothing
else fmap Just $ responseBody rsp $$+- CList.consume
return $ fmap fromChunks mr)
`Control.Exception.catch` (\(e :: SomeException) -> return Nothing),
write = \key str -> do
withSocketsDo $ withManager $ \mgr -> do
Aws.pureAws cfg s3cfg mgr
$ putObject
bucket
(fromString key)
(RequestBodyLBS str)
return(),
delete = \key -> withSocketsDo $ withManager $ \mgr -> do
Aws.pureAws cfg s3cfg mgr
$ DeleteObject (fromString key) bucket
return()
}