packages feed

tablestorage 0.1.0.3 → 0.2.1.0

raw patch · 14 files changed

+1123/−1066 lines, 14 filesdep +conduitdep +crypto-apidep +cryptohashsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: conduit, crypto-api, cryptohash, http-conduit, http-types, resourcet, transformers

API changes (from Hackage documentation)

+ Network.TableStorage.API: defaultConf :: AccountKey -> String -> String -> TableConf
+ Network.TableStorage.API: withTableStorage :: TableConf -> TableStorage a -> IO (Either TableError a)
+ Network.TableStorage.Development: developmentConf :: TableConf
+ Network.TableStorage.Types: QueryResponse :: Status -> String -> QueryResponse
+ Network.TableStorage.Types: TableConf :: Account -> Maybe Manager -> Maybe Proxy -> TableConf
+ Network.TableStorage.Types: TableOtherError :: String -> TableError
+ Network.TableStorage.Types: TableParseError :: TableError
+ Network.TableStorage.Types: TableUnknownError :: TableError
+ Network.TableStorage.Types: data QueryResponse
+ Network.TableStorage.Types: data TableConf
+ Network.TableStorage.Types: data TableError
+ Network.TableStorage.Types: httpManager :: TableConf -> Maybe Manager
+ Network.TableStorage.Types: httpProxy :: TableConf -> Maybe Proxy
+ Network.TableStorage.Types: instance Error TableError
+ Network.TableStorage.Types: instance Show TableError
+ Network.TableStorage.Types: tableAccount :: TableConf -> Account
+ Network.TableStorage.Types: type TableStorage = ErrorT TableError (ReaderT TableConf IO)
- Network.TableStorage.API: createTable :: Account -> String -> IO (Either String ())
+ Network.TableStorage.API: createTable :: String -> TableStorage ()
- Network.TableStorage.API: createTableIfNecessary :: Account -> String -> IO (Either String ())
+ Network.TableStorage.API: createTableIfNecessary :: String -> TableStorage ()
- Network.TableStorage.API: deleteEntity :: Account -> String -> EntityKey -> IO (Either String ())
+ Network.TableStorage.API: deleteEntity :: String -> EntityKey -> TableStorage ()
- Network.TableStorage.API: deleteTable :: Account -> String -> IO (Either String ())
+ Network.TableStorage.API: deleteTable :: String -> TableStorage ()
- Network.TableStorage.API: insertEntity :: Account -> String -> Entity -> IO (Either String ())
+ Network.TableStorage.API: insertEntity :: String -> Entity -> TableStorage ()
- Network.TableStorage.API: mergeEntity :: Account -> String -> Entity -> IO (Either String ())
+ Network.TableStorage.API: mergeEntity :: String -> Entity -> TableStorage ()
- Network.TableStorage.API: queryEntities :: Account -> String -> EntityQuery -> IO (Either String [Entity])
+ Network.TableStorage.API: queryEntities :: String -> EntityQuery -> TableStorage [Entity]
- Network.TableStorage.API: queryEntity :: Account -> String -> EntityKey -> IO (Either String Entity)
+ Network.TableStorage.API: queryEntity :: String -> EntityKey -> TableStorage Entity
- Network.TableStorage.API: queryTables :: Account -> IO (Either String [String])
+ Network.TableStorage.API: queryTables :: TableStorage [String]
- Network.TableStorage.API: updateEntity :: Account -> String -> Entity -> IO (Either String ())
+ Network.TableStorage.API: updateEntity :: String -> Entity -> TableStorage ()
- Network.TableStorage.Auth: authenticatedRequest :: Account -> RequestMethod -> [Header] -> String -> String -> String -> IO (Either String Response_String)
+ Network.TableStorage.Auth: authenticatedRequest :: Method -> [Header] -> String -> String -> String -> TableStorage QueryResponse
- Network.TableStorage.Types: SharedKeyAuth :: RequestMethod -> String -> String -> String -> String -> SharedKeyAuth
+ Network.TableStorage.Types: SharedKeyAuth :: Method -> String -> String -> String -> String -> SharedKeyAuth
- Network.TableStorage.Types: sharedKeyAuthVerb :: SharedKeyAuth -> RequestMethod
+ Network.TableStorage.Types: sharedKeyAuthVerb :: SharedKeyAuth -> Method

Files

LICENSE view
@@ -1,24 +1,24 @@-Copyright (c) 2012, Phil Freeman-All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:-    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.-    * Redistributions in binary form must reproduce the above copyright-      notice, this list of conditions and the following disclaimer in the-      documentation and/or other materials provided with the distribution.-    * Neither the name of the <organization> nor the-      names of its contributors may be used to endorse or promote products-      derived from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY-DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES-(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND-ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+Copyright (c) Phil Freeman, Aaron Friel 2012
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of the <organization> nor the
+      names of its contributors may be used to endorse or promote products
+      derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple
+main = defaultMain
src/Network/TableStorage.hs view
@@ -1,16 +1,16 @@--- | A simple wrapper for the Azure Table Storage REST API------ This module exists simply to re-export the following:------ * "Network.TableStorage.Types"------ * "Network.TableStorage.API"------ * "Network.TableStorage.Development"--module Network.TableStorage (module TableStorage) where--import Network.TableStorage.Types as TableStorage-import Network.TableStorage.API as TableStorage-import Network.TableStorage.Development as TableStorage-import Network.TableStorage.Query as TableStorage+-- | A simple wrapper for the Azure Table Storage REST API
+--
+-- This module exists simply to re-export the following:
+--
+-- * "Network.TableStorage.Types"
+--
+-- * "Network.TableStorage.API"
+--
+-- * "Network.TableStorage.Development"
+
+module Network.TableStorage (module TableStorage) where
+
+import Network.TableStorage.Types as TableStorage
+import Network.TableStorage.API as TableStorage
+import Network.TableStorage.Development as TableStorage
+import Network.TableStorage.Query as TableStorage
src/Network/TableStorage/API.hs view
@@ -1,237 +1,242 @@--- |--- This module provides functions wrapping the Azure REST API web methods.--module Network.TableStorage.API (-  queryTables, createTable, createTableIfNecessary, deleteTable,-  insertEntity, updateEntity, mergeEntity, deleteEntity, -  queryEntity, queryEntities, defaultEntityQuery,-  defaultAccount-) where--import Network.HTTP-    ( HeaderName(HdrCustom),-      Header(Header),-      RequestMethod(Custom, DELETE, GET, POST, PUT),-      Response_String )-import Text.XML.Light-    ( Element(elName),-      QName(qName, qURI),-      showTopElement,-      filterChildren,-      findAttr,-      findChild,-      findChildren,-      strContent )-import Network.TableStorage.Types-    ( EntityQuery(..),-      Entity(..),-      EntityColumn(EdmDateTime, EdmString),-      EntityKey(..),-      Account(..),-      AccountKey )-import Network.TableStorage.Auth ( authenticatedRequest )-import Network.TableStorage.Request-    ( propertyList, entityKeyResource, buildQueryString )-import Network.TableStorage.Response-    ( parseEmptyResponse, parseXmlResponseOrError, parseEntityColumn )-import Network.TableStorage.Atom-    ( dataServicesNamespace,-      qualifyAtom,-      qualifyDataServices,-      qualifyMetadata,-      wrapContent )-import Control.Monad ( (>=>), unless )-import Control.Monad.Error ( ErrorT(..) )-import Data.Time.Clock ( getCurrentTime )-import Data.Maybe ( fromMaybe )---- |--- Parse the response body of the Query Tables web method----parseQueryTablesResponse :: Response_String -> Either String [String]-parseQueryTablesResponse = parseXmlResponseOrError (2, 0, 0) readTables where-  readTables :: Element -> Maybe [String]-  readTables feed = sequence $ do-    entry <- findChildren (qualifyAtom "entry") feed-    return $ readTableName entry-  readTableName = -    findChild (qualifyAtom "content") -    >=> findChild (qualifyMetadata "properties") -    >=> findChild (qualifyDataServices "TableName") -    >=> return . strContent---- |--- List the names of tables for an account or returns an error message----queryTables :: Account -> IO (Either String [String])-queryTables acc = do-  let resource = "/Tables"-  response <- authenticatedRequest acc GET [] resource resource ""-  return $ response >>= parseQueryTablesResponse---- |--- Construct the request body for the Create Table web method----createTableXml :: String -> IO Element-createTableXml tableName = wrapContent $ propertyList [("TableName", EdmString $ Just tableName)]---- |--- Creates a new table with the specified name or returns an error message----createTable :: Account -> String -> IO (Either String ())-createTable acc tableName = do -  let resource = "/Tables"-  requestXml <- createTableXml tableName-  response <- authenticatedRequest acc POST [] resource resource $ showTopElement requestXml-  return $ response >>= parseEmptyResponse (2, 0, 1)---- |--- Creates a new table with the specified name if it does not already exist, or returns an erro message--- -createTableIfNecessary :: Account -> String -> IO (Either String ())-createTableIfNecessary acc tableName = runErrorT $ do -  tables <- ErrorT $ queryTables acc-  unless (tableName `elem` tables) $ ErrorT $ createTable acc tableName---- |--- Deletes the table with the specified name or returns an error message----deleteTable :: Account -> String -> IO (Either String ())-deleteTable acc tableName = do -  let resource = "/Tables('" ++ tableName ++ "')" -  response <- authenticatedRequest acc DELETE [] resource resource ""-  return $ response >>= parseEmptyResponse (2, 0, 4)---- |--- Construct the request body for the Insert Entity web method----createInsertEntityXml :: Entity -> IO Element-createInsertEntityXml entity = do-  time <- getCurrentTime-  wrapContent $ propertyList $ [-      ("PartitionKey", EdmString $ Just $ ekPartitionKey $ entityKey entity),-      ("RowKey",       EdmString $ Just $ ekRowKey $ entityKey entity),-      ("Timestamp",    EdmDateTime $ Just time) -    ] ++ entityColumns entity---- |--- Inserts an entity into the table with the specified name or returns an error message----insertEntity :: Account -> String -> Entity -> IO (Either String ())-insertEntity acc tableName entity = do -  let resource = '/' : tableName-  requestXml <- createInsertEntityXml entity-  response <- authenticatedRequest acc POST [] resource resource $ showTopElement requestXml-  return $ response >>= parseEmptyResponse (2, 0, 1)  ---- |--- Shared method to update or merge an existing entity. The only difference between the--- two methods is the request method used.----updateOrMergeEntity :: RequestMethod -> Account -> String -> Entity -> IO (Either String ())-updateOrMergeEntity method acc tableName entity = do -  let resource = entityKeyResource tableName $ entityKey entity-  let additionalHeaders = [ Header (HdrCustom "If-Match") "*" ]-  requestXml <- createInsertEntityXml entity-  response <- authenticatedRequest acc method additionalHeaders resource resource $ showTopElement requestXml-  return $ response >>= parseEmptyResponse (2, 0, 4)-  --- |--- Updates the specified entity (possibly removing columns) or returns an error message----updateEntity :: Account -> String -> Entity -> IO (Either String ())-updateEntity = updateOrMergeEntity PUT---- |--- Merges the specified entity (without removing columns) or returns an error message ----mergeEntity :: Account -> String -> Entity -> IO (Either String ())-mergeEntity = updateOrMergeEntity (Custom "MERGE")---- |--- Deletes the entity with the specified key or returns an error message ----deleteEntity :: Account -> String -> EntityKey -> IO (Either String ())-deleteEntity acc tableName key = do -  let resource = entityKeyResource tableName key-  let additionalHeaders = [ Header (HdrCustom "If-Match") "*" ]-  response <- authenticatedRequest acc DELETE additionalHeaders resource resource ""-  return $ response >>= parseEmptyResponse (2, 0, 4)---- |--- Parse an Atom entry as an entity ----readEntity :: Element -> Maybe Entity-readEntity entry = do-    properties <- -      findChild (qualifyAtom "content")-      >=> findChild (qualifyMetadata "properties")-      $ entry-    partitionKey <- findChild (qualifyDataServices "PartitionKey") properties-    rowKey <- findChild (qualifyDataServices "RowKey") properties-    let columnData = filterChildren filterProperties properties-    columns <- mapM elementToColumn columnData-    return Entity { entityKey = EntityKey { ekPartitionKey = strContent partitionKey,-                                            ekRowKey = strContent rowKey },-                    entityColumns = columns } where-  filterProperties el | elName el == qualifyDataServices "PartitionKey" = False-                      | elName el == qualifyDataServices "RowKey" = False-                      | otherwise = qURI (elName el) == Just dataServicesNamespace-  elementToColumn el = -    let propertyName = qName $ elName el in-    let typeAttr = fromMaybe "Edm.String" $ findAttr (qualifyMetadata "type") el in-    let typeNull = maybe False ("true" ==) $ findAttr (qualifyMetadata "null") el in  -    (\val -> (propertyName, val)) `fmap` parseEntityColumn typeNull typeAttr (strContent el)---- |--- Parse the response body of the Query Entity web method ----parseQueryEntityResponse :: Response_String -> Either String Entity-parseQueryEntityResponse = parseXmlResponseOrError (2, 0, 0) readEntity where ---- |--- Returns the entity with the specified table name and key or an error message----queryEntity :: Account -> String -> EntityKey -> IO (Either String Entity)-queryEntity acc tableName key = do -  let resource = entityKeyResource tableName key-  response <- authenticatedRequest acc GET [] resource resource ""-  return $ response >>= parseQueryEntityResponse---- |--- Parse the response body of the Query Entities web method----parseQueryEntitiesResponse :: Response_String -> Either String [Entity]-parseQueryEntitiesResponse = parseXmlResponseOrError (2, 0, 0) readEntities where-  readEntities :: Element -> Maybe [Entity]-  readEntities feed = sequence $ do-    entry <- findChildren (qualifyAtom "entry") feed-    return $ readEntity entry-  --- |--- Returns a collection of entities by executing the specified query or returns an error message ----queryEntities :: Account -> String -> EntityQuery -> IO (Either String [Entity])-queryEntities acc tableName query = do -  let canonicalizedResource = '/' : tableName ++ "()"-  let queryString = buildQueryString query-  let resource = canonicalizedResource ++ '?' : queryString-  response <- authenticatedRequest acc GET [] resource canonicalizedResource ""-  return $ response >>= parseQueryEntitiesResponse-  --- |--- An empty query with no filters and no specified page size ----defaultEntityQuery :: EntityQuery-defaultEntityQuery = EntityQuery { eqPageSize = Nothing,-                                   eqFilter = Nothing }-                                   --- | --- Constructs an Account with the default values for Port and Resource Prefix-defaultAccount :: AccountKey -> String -> String -> Account-defaultAccount key name hostname = Account { accountScheme              = "http",-                                             accountHost                = hostname,-                                             accountPort                = 80,-                                             accountKey                 = key,-                                             accountName                = name,-                                             accountResourcePrefix      = "" }+{-# LANGUAGE OverloadedStrings #-}
+-- |
+-- This module provides functions wrapping the Azure REST API web methods.
+
+module Network.TableStorage.API (
+  withTableStorage,
+  queryTables, createTable, createTableIfNecessary, deleteTable,
+  insertEntity, updateEntity, mergeEntity, deleteEntity,
+  queryEntity, queryEntities, defaultEntityQuery,
+  defaultAccount, defaultConf
+) where
+
+import Network.HTTP.Types
+import Text.XML.Light
+    ( Element(elName),
+      QName(qName, qURI),
+      showTopElement,
+      filterChildren,
+      findAttr,
+      findChild,
+      findChildren,
+      strContent )
+import Network.TableStorage.Types
+import Network.TableStorage.Auth
+import Network.TableStorage.Request
+import Network.TableStorage.Response
+import Network.TableStorage.Atom
+import Data.Time.Clock ( getCurrentTime )
+import Data.Maybe ( fromMaybe )
+import Control.Monad ( unless )
+import Control.Monad.Reader
+import Control.Monad.Error
+
+-- |
+-- Runs TableStorage actions given a configuration
+--
+withTableStorage :: TableConf -> TableStorage a -> IO (Either TableError a)
+withTableStorage conf f = runReaderT (runErrorT f) conf
+
+-- |
+-- Simple helper function to convert non-monadic parser results into the monadic result
+--
+fromEither :: MonadError e m => Either e a -> m a
+fromEither (Left e) = throwError e
+fromEither (Right a) = return a
+{-# INLINE fromEither #-}
+
+-- |
+-- Parse the response body of the Query Tables web method
+--
+parseQueryTablesResponse :: QueryResponse -> Either TableError [String]
+parseQueryTablesResponse = parseXmlResponseOrError status200 readTables where
+  readTables :: Element -> Maybe [String]
+  readTables feed = sequence $ do
+    entry <- findChildren (qualifyAtom "entry") feed
+    return $ readTableName entry
+  readTableName =
+    findChild (qualifyAtom "content")
+    >=> findChild (qualifyMetadata "properties")
+    >=> findChild (qualifyDataServices "TableName")
+    >=> return . strContent
+
+-- |
+-- List the names of tables for an account or returns an error message
+--
+queryTables :: TableStorage [String]
+queryTables = do
+  let resource = "/Tables"
+  response <- authenticatedRequest methodGet [] resource resource ""
+  fromEither $ parseQueryTablesResponse response
+
+-- |
+-- Construct the request body for the Create Table web method
+--
+createTableXml :: String -> IO Element
+createTableXml tableName = wrapContent Nothing $ propertyList [("TableName", EdmString $ Just tableName)]
+
+-- |
+-- Creates a new table with the specified name or returns an error message
+--
+createTable :: String -> TableStorage ()
+createTable tableName = do
+  let resource = "/Tables"
+  requestXml <- liftIO $ createTableXml tableName
+  response <- authenticatedRequest methodPost [] resource resource $ showTopElement requestXml
+  fromEither $ parseEmptyResponse status201 response
+
+-- |
+-- Creates a new table with the specified name if it does not already exist, or returns an erro message
+--
+createTableIfNecessary :: String -> TableStorage ()
+createTableIfNecessary tableName = do
+  tables <- queryTables
+  unless (tableName `elem` tables) $ createTable tableName
+
+-- |
+-- Deletes the table with the specified name or returns an error message
+--
+deleteTable :: String -> TableStorage ()
+deleteTable tableName = do
+  let resource = "/Tables('" ++ tableName ++ "')"
+  response <- authenticatedRequest methodDelete [] resource resource ""
+  fromEither $ parseEmptyResponse status204 response
+
+-- |
+-- Construct the request body for the Insert Entity web method
+--
+createInsertEntityXml :: Entity -> Maybe String -> IO Element
+createInsertEntityXml entity entityID = do
+  time <- getCurrentTime
+  wrapContent entityID $ propertyList $ [
+      ("PartitionKey", EdmString $ Just $ ekPartitionKey $ entityKey entity),
+      ("RowKey",       EdmString $ Just $ ekRowKey $ entityKey entity),
+      ("Timestamp",    EdmDateTime $ Just time)
+    ] ++ entityColumns entity
+
+-- |
+-- Inserts an entity into the table with the specified name or returns an error message
+--
+insertEntity :: String -> Entity -> TableStorage ()
+insertEntity tableName entity = do
+  let resource = '/' : tableName
+  requestXml <- liftIO $ createInsertEntityXml entity Nothing
+  response <- authenticatedRequest methodPost [] resource resource $ showTopElement requestXml
+  fromEither $ parseEmptyResponse status201 response
+
+-- |
+-- Shared method to update or merge an existing entity. The only difference between the
+-- two methods is the request method used.
+--
+updateOrMergeEntity :: Method -> String -> Entity -> TableStorage ()
+updateOrMergeEntity method tableName entity = do
+  let resource = entityKeyResource tableName $ entityKey entity
+  let additionalHeaders = [ ("If-Match", "*") ]
+  acc <- fmap tableAccount ask
+  requestXml <- liftIO $ createInsertEntityXml entity (Just $
+    accountScheme acc ++ "://" ++ accountHost acc ++ resource)
+  response <- authenticatedRequest method additionalHeaders resource resource $ showTopElement requestXml
+  fromEither $ parseEmptyResponse status204 response
+
+-- |
+-- Updates the specified entity (possibly removing columns) or returns an error message
+--
+updateEntity :: String -> Entity -> TableStorage ()
+updateEntity = updateOrMergeEntity methodPut
+
+-- |
+-- Merges the specified entity (without removing columns) or returns an error message
+--
+mergeEntity :: String -> Entity -> TableStorage ()
+mergeEntity = updateOrMergeEntity "MERGE"
+
+-- |
+-- Deletes the entity with the specified key or returns an error message
+--
+deleteEntity :: String -> EntityKey -> TableStorage ()
+deleteEntity tableName key = do
+  let resource = entityKeyResource tableName key
+  let additionalHeaders = [ ("If-Match", "*") ]
+  response <- authenticatedRequest methodDelete additionalHeaders resource resource ""
+  fromEither $ parseEmptyResponse status204 response
+
+-- |
+-- Parse an Atom entry as an entity
+--
+readEntity :: Element -> Maybe Entity
+readEntity entry = do
+    properties <-
+      findChild (qualifyAtom "content")
+      >=> findChild (qualifyMetadata "properties")
+      $ entry
+    partitionKey <- findChild (qualifyDataServices "PartitionKey") properties
+    rowKey <- findChild (qualifyDataServices "RowKey") properties
+    let columnData = filterChildren filterProperties properties
+    columns <- mapM elementToColumn columnData
+    return Entity { entityKey = EntityKey { ekPartitionKey = strContent partitionKey,
+                                            ekRowKey = strContent rowKey },
+                    entityColumns = columns } where
+  filterProperties el | elName el == qualifyDataServices "PartitionKey" = False
+                      | elName el == qualifyDataServices "RowKey" = False
+                      | otherwise = qURI (elName el) == Just dataServicesNamespace
+  elementToColumn el =
+    let propertyName = qName $ elName el in
+    let typeAttr = fromMaybe "Edm.String" $ findAttr (qualifyMetadata "type") el in
+    let typeNull = maybe False ("true" ==) $ findAttr (qualifyMetadata "null") el in
+    (\val -> (propertyName, val)) `fmap` parseEntityColumn typeNull typeAttr (strContent el)
+
+-- |
+-- Parse the response body of the Query Entity web method
+--
+parseQueryEntityResponse :: QueryResponse -> Either TableError Entity
+parseQueryEntityResponse = parseXmlResponseOrError status200 readEntity
+
+-- |
+-- Returns the entity with the specified table name and key or an error message
+--
+queryEntity :: String -> EntityKey -> TableStorage Entity
+queryEntity tableName key = do
+  let resource = entityKeyResource tableName key
+  response <- authenticatedRequest methodGet [] resource resource ""
+  fromEither $ parseQueryEntityResponse response
+
+-- |
+-- Parse the response body of the Query Entities web method
+--
+parseQueryEntitiesResponse :: QueryResponse -> Either TableError [Entity]
+parseQueryEntitiesResponse = parseXmlResponseOrError status200 readEntities where
+  readEntities :: Element -> Maybe [Entity]
+  readEntities feed = sequence $ do
+    entry <- findChildren (qualifyAtom "entry") feed
+    return $ readEntity entry
+
+-- |
+-- Returns a collection of entities by executing the specified query or returns an error message
+--
+queryEntities :: String -> EntityQuery -> TableStorage [Entity]
+queryEntities tableName query = do
+  let canonicalizedResource = '/' : tableName ++ "()"
+  let queryString = buildQueryString query
+  let resource = canonicalizedResource ++ '?' : queryString
+  response <- authenticatedRequest methodGet [] resource canonicalizedResource ""
+  fromEither $ parseQueryEntitiesResponse response
+
+-- |
+-- An empty query with no filters and no specified page size
+--
+defaultEntityQuery :: EntityQuery
+defaultEntityQuery = EntityQuery { eqPageSize = Nothing,
+                                   eqFilter = Nothing }
+
+-- |
+-- Constructs an Account with the default values for Port and Resource Prefix
+defaultAccount :: AccountKey -> String -> String -> Account
+defaultAccount key name hostname = Account { accountScheme              = "http:",
+                                             accountHost                = hostname,
+                                             accountPort                = 80,
+                                             accountKey                 = key,
+                                             accountName                = name,
+                                             accountResourcePrefix      = "" }
+
+defaultConf :: AccountKey -> String -> String -> TableConf
+defaultConf key name hostname = TableConf (defaultAccount key name hostname) Nothing Nothing
src/Network/TableStorage/Atom.hs view
@@ -1,85 +1,87 @@--- |--- Functions for constructing and parsing Atom feeds for use in the --- request and response bodies of the various web methods.-----module Network.TableStorage.Atom (-  atomNamespace, dataServicesNamespace, metadataNamespace,-  qualifyAtom, qualifyDataServices, qualifyMetadata,-  atomElement, atomAttr, wrapContent-) where--import Network.TableStorage.XML-    ( qualify, cDataText, namespaceAttr )-import Network.TableStorage.Format ( atomDate )-import Text.XML.Light-    ( Element(elAttribs, elContent, elName),-      Content(Elem),-      QName,-      Attr(..),-      blank_element,-      unqual )--atomNamespace :: String-atomNamespace = "http://www.w3.org/2005/Atom"--dataServicesNamespace :: String-dataServicesNamespace = "http://schemas.microsoft.com/ado/2007/08/dataservices"--metadataNamespace :: String-metadataNamespace = "http://schemas.microsoft.com/ado/2007/08/dataservices/metadata"--qualifyAtom :: String -> QName-qualifyAtom = qualify (Just atomNamespace) Nothing--qualifyDataServices :: String -> QName-qualifyDataServices = qualify (Just dataServicesNamespace) (Just "d")--qualifyMetadata :: String -> QName-qualifyMetadata = qualify (Just metadataNamespace) (Just "m")---- |--- An element in the Atom namespace with the provided attributes and child elements----atomElement :: String -> Maybe String -> [Attr] -> [Element] -> Element-atomElement name content attrs els  =-  blank_element { elName = qualifyAtom name,-                  elAttribs = attrs,-                  elContent = map Elem els ++ maybe [] cDataText content }-     --- |--- An attribute in the Atom namespace----atomAttr :: String -> String -> Attr-atomAttr name value =-  Attr { attrKey = qualifyAtom name,-         attrVal = value }---- |--- Create an Atom entry using the specified element as the content element----wrapContent :: Element -> IO Element-wrapContent content = do-  date <- atomDate-  return $ atomElement "entry" Nothing -    [-      Attr { attrKey = unqual "xmlns", attrVal = atomNamespace },-      namespaceAttr "d" dataServicesNamespace,-      namespaceAttr "m" metadataNamespace-    ] -    [-      atomElement "title" Nothing [] [],-      atomElement "updated" (Just date) [] [],-      atomElement "author" Nothing [] -      [-        atomElement "name" Nothing [] []-      ],-      atomElement "id" Nothing [] [],-      atomElement "content" Nothing -      [-        atomAttr "type" "application/xml"-      ] -      [ -        content +-- |
+-- Functions for constructing and parsing Atom feeds for use in the
+-- request and response bodies of the various web methods.
+--
+
+module Network.TableStorage.Atom (
+  atomNamespace, dataServicesNamespace, metadataNamespace,
+  qualifyAtom, qualifyDataServices, qualifyMetadata,
+  atomElement, atomAttr, wrapContent
+) where
+
+import Network.TableStorage.XML
+    ( qualify, cDataText, namespaceAttr )
+import Network.TableStorage.Format ( atomDate )
+import Text.XML.Light
+    ( Element(elAttribs, elContent, elName),
+      Content(Elem),
+      QName, CDataKind(..), Content(..), CData(..),
+      Attr(..),
+      blank_element,
+      unqual )
+import Data.Maybe (fromMaybe)
+
+atomNamespace :: String
+atomNamespace = "http://www.w3.org/2005/Atom"
+
+dataServicesNamespace :: String
+dataServicesNamespace = "http://schemas.microsoft.com/ado/2007/08/dataservices"
+
+metadataNamespace :: String
+metadataNamespace = "http://schemas.microsoft.com/ado/2007/08/dataservices/metadata"
+
+qualifyAtom :: String -> QName
+qualifyAtom = qualify (Just atomNamespace) Nothing
+
+qualifyDataServices :: String -> QName
+qualifyDataServices = qualify (Just dataServicesNamespace) (Just "d")
+
+qualifyMetadata :: String -> QName
+qualifyMetadata = qualify (Just metadataNamespace) (Just "m")
+
+-- |
+-- An element in the Atom namespace with the provided attributes and child elements
+--
+atomElement :: String -> Maybe String -> [Attr] -> [Element] -> Element
+atomElement name content attrs els  =
+  blank_element { elName = qualifyAtom name,
+                  elAttribs = attrs,
+                  elContent = map Elem els ++ maybe [] cDataText content }
+
+-- |
+-- An attribute in the Atom namespace
+--
+atomAttr :: String -> String -> Attr
+atomAttr name value =
+  Attr { attrKey = qualifyAtom name,
+         attrVal = value }
+
+-- |
+-- Create an Atom entry using the specified element as the content element
+--
+wrapContent :: Maybe String -> Element -> IO Element
+wrapContent entityID content = do
+  date <- atomDate
+  return $
+    atomElement "entry" Nothing
+      [ Attr { attrKey = unqual "xmlns", attrVal = atomNamespace }
+      , namespaceAttr "d" dataServicesNamespace
+      , namespaceAttr "m" metadataNamespace
+      ]
+      [ atomElement "category" Nothing
+          [ atomAttr "scheme" "http://schemas.microsoft.com/ado/2007/08/dataservices/scheme"
+          , atomAttr "term" "clio.cookies"
+          ] []
+      , atomElement "title" Nothing [] []
+      , atomElement "author" Nothing []
+          [ atomElement "name" Nothing [] [] ]
+      , atomElement "updated" (Just date) [] []
+      , blank_element
+        { elName = qualifyAtom "id"
+        , elAttribs = []
+        , elContent = [Text CData { cdVerbatim = CDataRaw, cdData = fromMaybe "" entityID, cdLine = Nothing }]
+        }
+      , atomElement "content" Nothing
+          [ atomAttr "type" "application/xml" ]
+          [ content ]
       ]-   ]
src/Network/TableStorage/Auth.hs view
@@ -1,131 +1,131 @@--- |--- This module provides functions to create authenticated requests to the Table--- Storage REST API.------ Functions are provided to create Shared Key authorization tokens, and to add the--- required headers for the various requests.-----module Network.TableStorage.Auth (-  authenticatedRequest-) where--import qualified Data.ByteString.Base64 as Base64C-    ( encode, decode )-import qualified Codec.Binary.UTF8.String as UTF8C ( encodeString )-import qualified Data.ByteString as B ( ByteString, concat )-import qualified Data.ByteString.UTF8 as UTF8-    ( toString, fromString )-import qualified Data.ByteString.Lazy.UTF8 as UTF8L ( fromString )-import qualified Data.ByteString.Lazy.Char8 as Char8L ( toChunks )-import qualified Data.ByteString.Lazy as L ( fromChunks )-import qualified Data.Digest.Pure.SHA as SHA-    ( bytestringDigest, hmacSha256 )-import Network.TCP ( HStream(close, openStream) )-import Network.URI-    ( URIAuth(URIAuth, uriPort, uriRegName, uriUserInfo), URI(..) )-import Network.HTTP-    ( HeaderName(HdrAccept, HdrAuthorization, HdrContentLength,-                 HdrContentType, HdrDate),-      Header(..),-      Request(Request, rqBody, rqHeaders, rqMethod, rqURI),-      RequestMethod,-      Response_String,-      sendHTTP )-import Network.HTTP.Base ()-import Network.Stream ( Result )-import Network.TableStorage.Types-    ( SharedKeyAuth(..),-      Account(accountHost, accountKey, accountName, accountPort,-              accountResourcePrefix, accountScheme),-      AuthHeader(..),-      Signature(..),-      AccountKey(unAccountKey) )-import Network.TableStorage.Format ( rfc1123Date )--authenticationType :: String-authenticationType = "SharedKey"---- |--- Constructs the unencrypted content of the Shared Key authentication token ----printSharedKeyAuth :: SharedKeyAuth -> String-printSharedKeyAuth auth = -  show (sharedKeyAuthVerb auth)-  ++ "\n" -  ++ sharedKeyAuthContentMD5 auth-  ++ "\n" -  ++ sharedKeyAuthContentType auth-  ++ "\n" -  ++ sharedKeyAuthDate auth -  ++ "\n" -  ++ sharedKeyAuthCanonicalizedResource auth-  -hmacSha256' :: AccountKey -> String -> B.ByteString-hmacSha256' base64Key = -  let (Right key) = Base64C.decode . UTF8.fromString . unAccountKey $ base64Key in-  B.concat . Char8L.toChunks . SHA.bytestringDigest . SHA.hmacSha256 (L.fromChunks $ return key) . UTF8L.fromString-  --- |--- Constructs the authorization signature----signature :: AccountKey -> SharedKeyAuth -> Signature-signature key = Signature . UTF8.toString . Base64C.encode . hmacSha256' key . UTF8C.encodeString . printSharedKeyAuth---- |--- Constructs the authorization header including account name and signature----authHeader :: Account -> SharedKeyAuth -> AuthHeader-authHeader acc auth = AuthHeader $-  authenticationType -  ++ " " -  ++ accountName acc -  ++ ":"-  ++ unSignature (signature (accountKey acc) auth)---- |--- Constructs an absolute URI from an Account and relative URI ----qualifyResource :: String -> Account -> URI-qualifyResource res acc =-  URI { uriScheme = accountScheme acc-      , uriAuthority =  -          Just URIAuth -          { uriRegName = accountHost acc-          , uriPort = ':' : show (accountPort acc)-          , uriUserInfo = "" }-      , uriQuery = ""-      , uriFragment = ""-      , uriPath = accountResourcePrefix acc ++ res }---- |--- Creates and executes an authenticated request including the Authorization header.------ The function takes the account information, request method, additional headers, --- resource, canonicalized resource and request body as parameters, and returns--- an error message or the response object.----authenticatedRequest :: Account -> RequestMethod -> [Header] -> String -> String -> String -> IO (Either String Response_String)-authenticatedRequest acc method hdrs resource canonicalizedResource body = do-  time <- rfc1123Date -  connection <- openStream (accountHost acc) (accountPort acc) -  let { auth = SharedKeyAuth -    { sharedKeyAuthVerb = method-    , sharedKeyAuthContentMD5 = ""-    , sharedKeyAuthContentType = "application/atom+xml"-    , sharedKeyAuthDate = time-    , sharedKeyAuthCanonicalizedResource = "/" ++ accountName acc ++ accountResourcePrefix acc ++ canonicalizedResource } }-  let { basicHeaders =-    [ Header HdrAuthorization $ unAuthHeader $ authHeader acc auth-    , Header HdrContentType "application/atom+xml"-    , Header HdrContentLength $ show $ length body-    , Header HdrAccept "application/atom+xml,application/xml"-    , Header HdrDate time ] }-  let { request = Request -    { rqURI = qualifyResource resource acc-    , rqMethod = method-    , rqHeaders = basicHeaders ++ hdrs-    , rqBody = body } }-  result <- sendHTTP connection request :: IO (Result Response_String)-  _ <- close connection-  return $ either (Left . show) Right result+{-# LANGUAGE OverloadedStrings #-}
+-- |
+-- This module provides functions to create authenticated requests to the Table
+-- Storage REST API.
+--
+-- Functions are provided to create Shared Key authorization tokens, and to add the
+-- required headers for the various requests.
+--
+
+module Network.TableStorage.Auth (
+  authenticatedRequest
+) where
+
+import qualified Data.ByteString.Base64 as Base64C
+    ( encode, decode )
+import qualified Codec.Binary.UTF8.String as UTF8C ( encodeString )
+import qualified Data.ByteString as B ( ByteString, concat )
+import qualified Data.ByteString.UTF8 as UTF8
+    ( toString, fromString )
+import qualified Data.ByteString.Lazy.UTF8 as UTF8L ( fromString, toString )
+import qualified Data.ByteString.Lazy.Char8 as Char8L ( toChunks )
+import qualified Data.ByteString.Lazy as L ( fromChunks )
+import Crypto.Hash.MD5 as MD5 (hash)
+import qualified Data.Digest.Pure.SHA as SHA
+    ( bytestringDigest, hmacSha256 )
+import Network.URI
+    ( URIAuth(URIAuth, uriPort, uriRegName, uriUserInfo), URI(..) )
+import Network.HTTP.Conduit
+import Network.HTTP.Conduit.Internal (setUri)
+import Network.HTTP.Types
+import Network.TableStorage.Types
+import Network.TableStorage.Format ( rfc1123Date )
+import Data.Monoid ((<>))
+import Control.Monad.Reader
+import Control.Monad.Trans.Resource
+
+authenticationType :: String
+authenticationType = "SharedKey"
+
+-- |
+-- Constructs the unencrypted content of the Shared Key authentication token
+--
+printSharedKeyAuth :: SharedKeyAuth -> String
+printSharedKeyAuth auth =
+  UTF8.toString (sharedKeyAuthVerb auth)
+  ++ "\n"
+  ++ sharedKeyAuthContentMD5 auth
+  ++ "\n"
+  ++ sharedKeyAuthContentType auth
+  ++ "\n"
+  ++ sharedKeyAuthDate auth
+  ++ "\n"
+  ++ sharedKeyAuthCanonicalizedResource auth
+
+hmacSha256' :: AccountKey -> String -> B.ByteString
+hmacSha256' base64Key =
+  let (Right key) = Base64C.decode . UTF8.fromString . unAccountKey $ base64Key in
+  B.concat . Char8L.toChunks . SHA.bytestringDigest . SHA.hmacSha256 (L.fromChunks $ return key) . UTF8L.fromString
+
+-- |
+-- Constructs the authorization signature
+--
+signature :: AccountKey -> SharedKeyAuth -> Signature
+signature key = Signature . UTF8.toString . Base64C.encode . hmacSha256' key . UTF8C.encodeString . printSharedKeyAuth
+
+-- |
+-- Constructs the authorization header including account name and signature
+--
+authHeader :: Account -> SharedKeyAuth -> AuthHeader
+authHeader acc auth = AuthHeader $
+  authenticationType
+  ++ " "
+  ++ accountName acc
+  ++ ":"
+  ++ unSignature (signature (accountKey acc) auth)
+
+-- |
+-- Constructs an absolute URI from an Account and relative URI
+--
+qualifyResource :: String -> Account -> URI
+qualifyResource res acc =
+  URI { uriScheme = accountScheme acc
+      , uriAuthority =
+          Just URIAuth
+          { uriRegName = accountHost acc
+          , uriPort = ':' : show (accountPort acc)
+          , uriUserInfo = "" }
+      , uriQuery = ""
+      , uriFragment = ""
+      , uriPath = accountResourcePrefix acc ++ res }
+
+-- |
+-- Creates and executes an authenticated request including the Authorization header.
+--
+-- The function takes the account information, request method, additional headers,
+-- resource, canonicalized resource and request body as parameters, and returns
+-- an error message or the response object.
+--
+authenticatedRequest :: Method -> [Header] -> String -> String -> String -> TableStorage QueryResponse
+authenticatedRequest mthd hdrs resource canonicalizedResource body = do
+  time <- liftIO rfc1123Date
+  (TableConf acc maybeMgr maybeProxy) <- ask
+  let contentMD5 =  (Base64C.encode . hash . UTF8.fromString) body
+  let atomType = "application/atom+xml" :: B.ByteString
+  let auth = SharedKeyAuth { sharedKeyAuthVerb = mthd
+                           , sharedKeyAuthContentMD5 = UTF8.toString contentMD5
+                           , sharedKeyAuthContentType = UTF8.toString atomType
+                           , sharedKeyAuthDate = time
+                           , sharedKeyAuthCanonicalizedResource = "/" ++ accountName acc ++ accountResourcePrefix acc ++ canonicalizedResource }
+  let uri = qualifyResource resource acc
+  let defaultReq = def  { method = mthd
+                        , requestHeaders = [ (hAuthorization,          UTF8.fromString . unAuthHeader $ authHeader acc auth)
+                                           , (hContentType,            atomType)
+                                           , (hContentMD5,             contentMD5)
+                                           , (hAccept,                 atomType <> ",application/xml")
+                                           , (hDate,                   UTF8.fromString time)
+                                           , ("x-ms-date",             UTF8.fromString time)
+                                           , ("x-ms-version",          "2009-09-19")
+                                           , ("DataServiceVersion",    "1.0;NetFx")
+                                           , ("MaxDataServiceVersion", "2.0;NetFx")
+                                           ] ++ hdrs
+                        , requestBody = RequestBodyBS $ UTF8.fromString body
+                        , redirectCount = 0
+                        , checkStatus = \_ _ -> Nothing
+                        , proxy = maybeProxy
+                        }
+  request <- setUri defaultReq uri
+  response <- case maybeMgr of
+                Just mgr -> runResourceT $ httpLbs request mgr
+                Nothing  -> withManager (httpLbs request)
+  return $ QueryResponse (responseStatus response) (UTF8L.toString $ responseBody response)
src/Network/TableStorage/Development.hs view
@@ -1,21 +1,24 @@--- |--- This module contains constants for working with the storage emulator.  -----module Network.TableStorage.Development (-  developmentAccount-) where--import Network.TableStorage.Types-    ( Account(..), AccountKey(AccountKey) )---- |--- An account for the storage emulator----developmentAccount :: Account-developmentAccount = Account { accountScheme            = "http",-                               accountHost              = "127.0.0.1" ,-                               accountName              = "devstoreaccount1",-                               accountPort              = 10002,-                               accountResourcePrefix    = "/devstoreaccount1",-                               accountKey               = AccountKey "Eby8vdM02xNOcqFlqUwJPLlmEtlCDXJ1OUzFT50uSRZ6IFsuFq2UVErCz4I6tq/K1SZFPTOtr/KBHBeksoGMGw=="}+-- |
+-- This module contains constants for working with the storage emulator.
+--
+
+module Network.TableStorage.Development (
+  developmentAccount, developmentConf
+) where
+
+import Network.TableStorage.Types
+    ( Account(..), AccountKey(AccountKey), TableConf(..) )
+
+-- |
+-- An account for the storage emulator
+--
+developmentAccount :: Account
+developmentAccount = Account { accountScheme            = "http:",
+                               accountHost              = "127.0.0.1" ,
+                               accountName              = "devstoreaccount1",
+                               accountPort              = 10002,
+                               accountResourcePrefix    = "/devstoreaccount1",
+                               accountKey               = AccountKey "Eby8vdM02xNOcqFlqUwJPLlmEtlCDXJ1OUzFT50uSRZ6IFsuFq2UVErCz4I6tq/K1SZFPTOtr/KBHBeksoGMGw=="}
+
+developmentConf :: TableConf
+developmentConf = TableConf developmentAccount Nothing Nothing
src/Network/TableStorage/Format.hs view
@@ -1,26 +1,26 @@--- |--- Helper methods for working with formatted dates-----module Network.TableStorage.Format (-  getFormattedTime, rfc1123Date, atomDate,  -  rfc1123Format, atomDateFormat-) where--import Data.Time ( getCurrentTime, formatTime )-import System.Locale ( defaultTimeLocale )--getFormattedTime :: String -> IO String-getFormattedTime formatString = fmap (formatTime defaultTimeLocale formatString) getCurrentTime--rfc1123Date :: IO String-rfc1123Date = getFormattedTime rfc1123Format--atomDate :: IO String-atomDate = getFormattedTime atomDateFormat--rfc1123Format :: String-rfc1123Format = "%a, %d %b %Y %H:%M:%S GMT"--atomDateFormat :: String+-- |
+-- Helper methods for working with formatted dates
+--
+
+module Network.TableStorage.Format (
+  getFormattedTime, rfc1123Date, atomDate,
+  rfc1123Format, atomDateFormat
+) where
+
+import Data.Time ( getCurrentTime, formatTime )
+import System.Locale ( defaultTimeLocale )
+
+getFormattedTime :: String -> IO String
+getFormattedTime formatString = fmap (formatTime defaultTimeLocale formatString) getCurrentTime
+
+rfc1123Date :: IO String
+rfc1123Date = getFormattedTime rfc1123Format
+
+atomDate :: IO String
+atomDate = getFormattedTime atomDateFormat
+
+rfc1123Format :: String
+rfc1123Format = "%a, %d %b %Y %H:%M:%S GMT"
+
+atomDateFormat :: String
 atomDateFormat = "%Y-%m-%dT%H:%M:%S%QZ"
src/Network/TableStorage/Query.hs view
@@ -1,85 +1,85 @@--- |--- This module contains functions which help when unmarshalling query responses--module Network.TableStorage.Query (-  edmBinary, edmBoolean, edmDateTime, edmDouble,-  edmGuid, edmInt32, edmInt64, edmString-) where--import Data.Time ( UTCTime )-import Network.TableStorage.Types-    ( Entity(entityColumns),-      EntityColumn(EdmBinary, EdmBoolean, EdmDateTime, EdmDouble,-                   EdmGuid, EdmInt32, EdmInt64, EdmString) )---- |--- Find the value in a binary-valued column or return Nothing if no such column exists-edmBinary :: String -> Entity -> Maybe String-edmBinary key en = do-  col <- lookup key $ entityColumns en-  case col of-    EdmBinary s -> s-    _ -> Nothing-    --- |--- Find the value in a string-valued column or return Nothing if no such column exists-edmString :: String -> Entity -> Maybe String-edmString key en = do-  col <- lookup key $ entityColumns en-  case col of-    EdmString s -> s-    _ -> Nothing---- |--- Find the value in a boolean-valued column or return Nothing if no such column exists-edmBoolean :: String -> Entity -> Maybe Bool-edmBoolean key en = do-  col <- lookup key $ entityColumns en-  case col of-    EdmBoolean s -> s-    _ -> Nothing---- |--- Find the value in a date-valued column or return Nothing if no such column exists-edmDateTime :: String -> Entity -> Maybe UTCTime-edmDateTime key en = do-  col <- lookup key $ entityColumns en-  case col of-    EdmDateTime s -> s-    _ -> Nothing---- |--- Find the value in a double-valued column or return Nothing if no such column exists-edmDouble :: String -> Entity -> Maybe Double-edmDouble key en = do-  col <- lookup key $ entityColumns en-  case col of-    EdmDouble s -> s-    _ -> Nothing---- |--- Find the value in a Guid-valued column or return Nothing if no such column exists-edmGuid :: String -> Entity -> Maybe String-edmGuid key en = do-  col <- lookup key $ entityColumns en-  case col of-    EdmGuid s -> s-    _ -> Nothing---- |--- Find the value in an integer-valued column or return Nothing if no such column exists-edmInt32 :: String -> Entity -> Maybe Int-edmInt32 key en = do-  col <- lookup key $ entityColumns en-  case col of-    EdmInt32 s -> s-    _ -> Nothing---- |--- Find the value in an integer-valued column or return Nothing if no such column exists-edmInt64 :: String -> Entity -> Maybe Int-edmInt64 key en = do-  col <- lookup key $ entityColumns en-  case col of-    EdmInt64 s -> s+-- |
+-- This module contains functions which help when unmarshalling query responses
+
+module Network.TableStorage.Query (
+  edmBinary, edmBoolean, edmDateTime, edmDouble,
+  edmGuid, edmInt32, edmInt64, edmString
+) where
+
+import Data.Time ( UTCTime )
+import Network.TableStorage.Types
+    ( Entity(entityColumns),
+      EntityColumn(EdmBinary, EdmBoolean, EdmDateTime, EdmDouble,
+                   EdmGuid, EdmInt32, EdmInt64, EdmString) )
+
+-- |
+-- Find the value in a binary-valued column or return Nothing if no such column exists
+edmBinary :: String -> Entity -> Maybe String
+edmBinary key en = do
+  col <- lookup key $ entityColumns en
+  case col of
+    EdmBinary s -> s
+    _ -> Nothing
+
+-- |
+-- Find the value in a string-valued column or return Nothing if no such column exists
+edmString :: String -> Entity -> Maybe String
+edmString key en = do
+  col <- lookup key $ entityColumns en
+  case col of
+    EdmString s -> s
+    _ -> Nothing
+
+-- |
+-- Find the value in a boolean-valued column or return Nothing if no such column exists
+edmBoolean :: String -> Entity -> Maybe Bool
+edmBoolean key en = do
+  col <- lookup key $ entityColumns en
+  case col of
+    EdmBoolean s -> s
+    _ -> Nothing
+
+-- |
+-- Find the value in a date-valued column or return Nothing if no such column exists
+edmDateTime :: String -> Entity -> Maybe UTCTime
+edmDateTime key en = do
+  col <- lookup key $ entityColumns en
+  case col of
+    EdmDateTime s -> s
+    _ -> Nothing
+
+-- |
+-- Find the value in a double-valued column or return Nothing if no such column exists
+edmDouble :: String -> Entity -> Maybe Double
+edmDouble key en = do
+  col <- lookup key $ entityColumns en
+  case col of
+    EdmDouble s -> s
+    _ -> Nothing
+
+-- |
+-- Find the value in a Guid-valued column or return Nothing if no such column exists
+edmGuid :: String -> Entity -> Maybe String
+edmGuid key en = do
+  col <- lookup key $ entityColumns en
+  case col of
+    EdmGuid s -> s
+    _ -> Nothing
+
+-- |
+-- Find the value in an integer-valued column or return Nothing if no such column exists
+edmInt32 :: String -> Entity -> Maybe Int
+edmInt32 key en = do
+  col <- lookup key $ entityColumns en
+  case col of
+    EdmInt32 s -> s
+    _ -> Nothing
+
+-- |
+-- Find the value in an integer-valued column or return Nothing if no such column exists
+edmInt64 :: String -> Entity -> Maybe Int
+edmInt64 key en = do
+  col <- lookup key $ entityColumns en
+  case col of
+    EdmInt64 s -> s
     _ -> Nothing
src/Network/TableStorage/Request.hs view
@@ -1,158 +1,158 @@--- |--- Helper methods used to construct requests.-----module Network.TableStorage.Request (-  propertyList,-  entityKeyResource,-  columnToTypeString,-  printEntityColumn,-  printComparisonType,-  buildFilterString,-  buildQueryString-) where--import Data.Time ( formatTime )-import System.Locale ( defaultTimeLocale )-import Data.Maybe ( fromMaybe )-import Data.List ( intercalate )-import Text.XML.Light.Types ( elAttribs )-import Text.XML.Light-    ( Element(elAttribs, elContent, elName),-      Content(Elem),-      Attr(Attr),-      blank_element )-import Network.TableStorage.Types-    ( EntityFilter(..),-      ComparisonType(..),-      EntityQuery(eqFilter, eqPageSize),-      EntityColumn(..),-      EntityKey(ekPartitionKey, ekRowKey) )-import Network.TableStorage.XML ( cDataText )-import Network.TableStorage.Atom-    ( qualifyDataServices, qualifyMetadata )-import Network.TableStorage.Format ( atomDateFormat )-import Network.HTTP.Base ( urlEncode )---- |--- Formats a list of entity properties for inclusion in an Atom entry. ----propertyList :: [(String, EntityColumn)] -> Element-propertyList props = -  blank_element { elName = qualifyMetadata "properties",-                  elContent = map property props } where-  property (key, value) =-    let stringValue = printEntityColumn value in-    Elem blank_element { elName = qualifyDataServices key,-                         elAttribs = [ Attr (qualifyMetadata "type") $ columnToTypeString value, -                                       Attr (qualifyMetadata "null") $ maybe "true" (const "false") stringValue ],-                         elContent = cDataText $ fromMaybe "" stringValue }---- |--- Constructs relative URIs which refer to the entity with the specified table name--- and entity key. ----entityKeyResource :: String -> EntityKey -> String-entityKeyResource tableName key = tableName ++ "(PartitionKey='" ++ ekPartitionKey key ++ "',RowKey='" ++ ekRowKey key ++ "')"---- |--- Converts an entity column into its type name----columnToTypeString :: EntityColumn -> String-columnToTypeString (EdmBinary _)        = "Edm.Binary"-columnToTypeString (EdmBoolean _)       = "Edm.Boolean"-columnToTypeString (EdmDateTime _)      = "Edm.DateTime"-columnToTypeString (EdmDouble _)        = "Edm.Double"-columnToTypeString (EdmGuid _)          = "Edm.EdmGuid"-columnToTypeString (EdmInt32 _)         = "Edm.Int32"-columnToTypeString (EdmInt64 _)         = "Edm.Int64"-columnToTypeString (EdmString _)        = "Edm.String"---- |--- Formats a column value to appear in the body of an Atom entry----printEntityColumn :: EntityColumn -> Maybe String-printEntityColumn (EdmBinary (Just val))       = Just val-printEntityColumn (EdmBoolean (Just True))     = Just "true"-printEntityColumn (EdmBoolean (Just False))    = Just "false"-printEntityColumn (EdmDateTime (Just val))     = Just $ formatTime defaultTimeLocale atomDateFormat val-printEntityColumn (EdmDouble (Just val))       = Just $ show val-printEntityColumn (EdmGuid (Just val))         = Just val-printEntityColumn (EdmInt32 (Just val))        = Just $ show val-printEntityColumn (EdmInt64 (Just val))        = Just $ show val-printEntityColumn (EdmString (Just val))       = Just val-printEntityColumn _                            = Nothing---- |--- Formats a comparison type to appear in the query string----printComparisonType :: ComparisonType -> String-printComparisonType Equal               = "eq"-printComparisonType GreaterThan         = "gt"-printComparisonType GreaterThanOrEqual  = "ge" -printComparisonType LessThan            = "lt"-printComparisonType LessThanOrEqual     = "le" -printComparisonType NotEqual            = "ne"---- |--- Converts entity filter values into strings to appear in the filter--- portion of the Query Entities URI. ----buildFilterString :: EntityFilter -> String-buildFilterString (And fs) = '(' : intercalate "%20and%20" (map buildFilterString fs) ++ ")"-buildFilterString (Or fs) = '(' : intercalate "%20or%20" (map buildFilterString fs) ++ ")"-buildFilterString (Not f) = -  "(not%20" -  ++ buildFilterString f -  ++ ")"-buildFilterString (CompareBoolean prop val) = -  urlEncode prop -  ++ "%20eq%20" -  ++ if val then "true" else "false"-buildFilterString (CompareDateTime prop cmp val) = -  urlEncode prop -  ++ "%20"-  ++ printComparisonType cmp -  ++ "%20datetime'" -  ++ formatTime defaultTimeLocale atomDateFormat val -  ++ "'"-buildFilterString (CompareDouble prop cmp val) = -  urlEncode prop-  ++ "%20" -  ++ printComparisonType cmp -  ++ "%20" -  ++ show val-buildFilterString (CompareGuid prop val) = -  urlEncode prop -  ++ "%20eq%20guid'" -  ++ val-  ++ "'"-buildFilterString (CompareInt32 prop cmp val) = -  urlEncode prop -  ++ "%20" -  ++ printComparisonType cmp -  ++ "%20" -  ++ show val-buildFilterString (CompareInt64 prop cmp val) = -  urlEncode prop -  ++ "%20" -  ++ printComparisonType cmp -  ++ "%20" -  ++ show val-buildFilterString (CompareString prop cmp val) = -  urlEncode prop -  ++ "%20" -  ++ printComparisonType cmp-  ++ "%20'" -  ++ urlEncode val -  ++ "'"---- |--- Constructs the full query string for the Query Entities web method. ----buildQueryString :: EntityQuery -> String-buildQueryString query = -  "$filter="-  ++ maybe "" buildFilterString (eqFilter query) -  ++ "&$top=" -  ++ maybe "" show (eqPageSize query)  +-- |
+-- Helper methods used to construct requests.
+--
+
+module Network.TableStorage.Request (
+  propertyList,
+  entityKeyResource,
+  columnToTypeString,
+  printEntityColumn,
+  printComparisonType,
+  buildFilterString,
+  buildQueryString
+) where
+
+import Data.Time ( formatTime )
+import System.Locale ( defaultTimeLocale )
+import Data.Maybe ( fromMaybe )
+import Data.List ( intercalate )
+import Text.XML.Light.Types ( elAttribs )
+import Text.XML.Light
+    ( Element(elContent, elName),
+      Content(Elem),
+      Attr(Attr),
+      blank_element )
+import Network.TableStorage.Types
+    ( EntityFilter(..),
+      ComparisonType(..),
+      EntityQuery(eqFilter, eqPageSize),
+      EntityColumn(..),
+      EntityKey(ekPartitionKey, ekRowKey) )
+import Network.TableStorage.XML ( cDataText )
+import Network.TableStorage.Atom
+    ( qualifyDataServices, qualifyMetadata )
+import Network.TableStorage.Format ( atomDateFormat )
+import Network.HTTP.Base ( urlEncode )
+
+-- |
+-- Formats a list of entity properties for inclusion in an Atom entry.
+--
+propertyList :: [(String, EntityColumn)] -> Element
+propertyList props =
+  blank_element { elName = qualifyMetadata "properties",
+                  elContent = map property props } where
+  property (key, value) =
+    let stringValue = printEntityColumn value in
+    Elem blank_element { elName = qualifyDataServices key,
+                         elAttribs = [ Attr (qualifyMetadata "type") $ columnToTypeString value,
+                                       Attr (qualifyMetadata "null") $ maybe "true" (const "false") stringValue ],
+                         elContent = cDataText $ fromMaybe "" stringValue }
+
+-- |
+-- Constructs relative URIs which refer to the entity with the specified table name
+-- and entity key.
+--
+entityKeyResource :: String -> EntityKey -> String
+entityKeyResource tableName key = "/" ++ tableName ++ "(PartitionKey='" ++ ekPartitionKey key ++ "',RowKey='" ++ ekRowKey key ++ "')"
+
+-- |
+-- Converts an entity column into its type name
+--
+columnToTypeString :: EntityColumn -> String
+columnToTypeString (EdmBinary _)        = "Edm.Binary"
+columnToTypeString (EdmBoolean _)       = "Edm.Boolean"
+columnToTypeString (EdmDateTime _)      = "Edm.DateTime"
+columnToTypeString (EdmDouble _)        = "Edm.Double"
+columnToTypeString (EdmGuid _)          = "Edm.EdmGuid"
+columnToTypeString (EdmInt32 _)         = "Edm.Int32"
+columnToTypeString (EdmInt64 _)         = "Edm.Int64"
+columnToTypeString (EdmString _)        = "Edm.String"
+
+-- |
+-- Formats a column value to appear in the body of an Atom entry
+--
+printEntityColumn :: EntityColumn -> Maybe String
+printEntityColumn (EdmBinary (Just val))       = Just val
+printEntityColumn (EdmBoolean (Just True))     = Just "true"
+printEntityColumn (EdmBoolean (Just False))    = Just "false"
+printEntityColumn (EdmDateTime (Just val))     = Just $ formatTime defaultTimeLocale atomDateFormat val
+printEntityColumn (EdmDouble (Just val))       = Just $ show val
+printEntityColumn (EdmGuid (Just val))         = Just val
+printEntityColumn (EdmInt32 (Just val))        = Just $ show val
+printEntityColumn (EdmInt64 (Just val))        = Just $ show val
+printEntityColumn (EdmString (Just val))       = Just val
+printEntityColumn _                            = Nothing
+
+-- |
+-- Formats a comparison type to appear in the query string
+--
+printComparisonType :: ComparisonType -> String
+printComparisonType Equal               = "eq"
+printComparisonType GreaterThan         = "gt"
+printComparisonType GreaterThanOrEqual  = "ge"
+printComparisonType LessThan            = "lt"
+printComparisonType LessThanOrEqual     = "le"
+printComparisonType NotEqual            = "ne"
+
+-- |
+-- Converts entity filter values into strings to appear in the filter
+-- portion of the Query Entities URI.
+--
+buildFilterString :: EntityFilter -> String
+buildFilterString (And fs) = '(' : intercalate "%20and%20" (map buildFilterString fs) ++ ")"
+buildFilterString (Or fs) = '(' : intercalate "%20or%20" (map buildFilterString fs) ++ ")"
+buildFilterString (Not f) =
+  "(not%20"
+  ++ buildFilterString f
+  ++ ")"
+buildFilterString (CompareBoolean prop val) =
+  urlEncode prop
+  ++ "%20eq%20"
+  ++ if val then "true" else "false"
+buildFilterString (CompareDateTime prop cmp val) =
+  urlEncode prop
+  ++ "%20"
+  ++ printComparisonType cmp
+  ++ "%20datetime'"
+  ++ formatTime defaultTimeLocale atomDateFormat val
+  ++ "'"
+buildFilterString (CompareDouble prop cmp val) =
+  urlEncode prop
+  ++ "%20"
+  ++ printComparisonType cmp
+  ++ "%20"
+  ++ show val
+buildFilterString (CompareGuid prop val) =
+  urlEncode prop
+  ++ "%20eq%20guid'"
+  ++ val
+  ++ "'"
+buildFilterString (CompareInt32 prop cmp val) =
+  urlEncode prop
+  ++ "%20"
+  ++ printComparisonType cmp
+  ++ "%20"
+  ++ show val
+buildFilterString (CompareInt64 prop cmp val) =
+  urlEncode prop
+  ++ "%20"
+  ++ printComparisonType cmp
+  ++ "%20"
+  ++ show val
+buildFilterString (CompareString prop cmp val) =
+  urlEncode prop
+  ++ "%20"
+  ++ printComparisonType cmp
+  ++ "%20'"
+  ++ urlEncode val
+  ++ "'"
+
+-- |
+-- Constructs the full query string for the Query Entities web method.
+--
+buildQueryString :: EntityQuery -> String
+buildQueryString query =
+  "$filter="
+  ++ maybe "" buildFilterString (eqFilter query)
+  ++ "&$top="
+  ++ maybe "" show (eqPageSize query)
src/Network/TableStorage/Response.hs view
@@ -1,82 +1,79 @@--- |--- Helper methods for parsing web method response bodies. -----module Network.TableStorage.Response (-  parseError, errorToString,-  parseEmptyResponse, parseXmlResponseOrError,-  parseEntityColumn-) where--import Data.Time ( readTime )-import System.Locale ( defaultTimeLocale )-import Text.XML.Light-    ( Element(elName), parseXMLDoc, findChild, strContent )-import Control.Monad ( guard )-import Data.Maybe ( fromMaybe )-import Network.TableStorage.Atom ( qualifyMetadata )-import Network.TableStorage.Types ( EntityColumn(..) )-import Network.TableStorage.Format ( atomDateFormat )-import Network.HTTP.Base-    ( ResponseCode, Response(rspBody, rspCode), Response_String )---- |--- Extracts the error message from an error response ----parseError :: Element -> Maybe String-parseError root = do-  guard $ qualifyMetadata "error" == elName root-  message <- findChild (qualifyMetadata "message") root-  return $ strContent message---- |--- Summarize an error appearing in a response body or return "Unknown error" if the response cannot be parsed----errorToString :: Response_String -> String-errorToString res = fromMaybe "Unknown error" (parseXMLDoc (rspBody res) >>= parseError)---- |--- Verifies a response code, parsing an error message if necessary.----parseEmptyResponse :: ResponseCode -> Response_String -> Either String ()-parseEmptyResponse code res = -  if rspCode res == code -  then-    Right ()-  else-    Left $ errorToString res---- |--- Parse an XML response, or an error response as appropriate.----parseXmlResponseOrError :: ResponseCode -> (Element -> Maybe a) -> Response_String -> Either String a-parseXmlResponseOrError code parse res = -  let xmlDoc = parseXMLDoc (rspBody res) in-  if rspCode res == code -  then-    maybe (Left "Unable to parse result") Right $ xmlDoc >>= parse-  else-    Left $ fromMaybe "Unknown error" (xmlDoc >>= parseError)---- |--- Parses an entity column type and value----parseEntityColumn :: Bool -> String -> String -> Maybe EntityColumn-parseEntityColumn True  "Edm.Binary"   _        = Just $ EdmBinary Nothing-parseEntityColumn False "Edm.Binary"   val      = Just $ EdmBinary $ Just val-parseEntityColumn True  "Edm.Boolean"  _        = Just $ EdmBoolean Nothing-parseEntityColumn False "Edm.Boolean"  "true"   = Just $ EdmBoolean $ Just True-parseEntityColumn False "Edm.Boolean"  "false"  = Just $ EdmBoolean $ Just False-parseEntityColumn True  "Edm.DateTime" _        = Just $ EdmDateTime Nothing-parseEntityColumn False "Edm.DateTime" val      = Just $ EdmDateTime $ Just $ readTime defaultTimeLocale atomDateFormat val-parseEntityColumn True  "Edm.Double"   _        = Just $ EdmDouble Nothing-parseEntityColumn False "Edm.Double"   val      = Just $ EdmDouble $ Just $ read val-parseEntityColumn True  "Edm.Guid"     _        = Just $ EdmGuid Nothing-parseEntityColumn False "Edm.Guid"     val      = Just $ EdmGuid $ Just val-parseEntityColumn True  "Edm.Int32"    _        = Just $ EdmInt32 Nothing-parseEntityColumn False "Edm.Int32"    val      = Just $ EdmInt32 $ Just $ read val-parseEntityColumn True  "Edm.Int64"    _        = Just $ EdmInt64 Nothing-parseEntityColumn False "Edm.Int64"    val      = Just $ EdmInt64 $ Just $ read val-parseEntityColumn True  "Edm.String"   _        = Just $ EdmString Nothing-parseEntityColumn False "Edm.String"   val      = Just $ EdmString $ Just val+-- |
+-- Helper methods for parsing web method response bodies.
+--
+
+module Network.TableStorage.Response (
+  parseError,
+  parseEmptyResponse, parseXmlResponseOrError,
+  parseEntityColumn
+) where
+
+import Data.Time ( readTime )
+import System.Locale ( defaultTimeLocale )
+import Text.XML.Light
+    ( Element(elName), parseXMLDoc, findChild, strContent )
+import Network.TableStorage.Atom
+import Network.TableStorage.Types
+import Network.TableStorage.Format
+import Network.HTTP.Types
+import Control.Monad.Error
+
+-- |
+-- Extracts the error message from an error response
+--
+parseErrorMaybe :: Element -> Maybe String
+parseErrorMaybe root = do
+  guard $ qualifyMetadata "error" == elName root
+  message <- findChild (qualifyMetadata "message") root
+  return $ strContent message
+
+parseError :: Maybe Element -> TableError
+parseError e = case e >>= parseErrorMaybe of
+                Nothing -> TableUnknownError
+                Just s  -> TableOtherError s
+
+-- |
+-- Verifies a response status, parsing an error message if necessary.
+--
+parseEmptyResponse :: Status -> QueryResponse -> Either TableError ()
+parseEmptyResponse status (QueryResponse rspStatus rspBody) =
+  if rspStatus == status
+  then
+    Right ()
+  else
+    Left $ parseError $ parseXMLDoc rspBody
+
+-- |
+-- Parse an XML response, or an error response as appropriate.
+--
+parseXmlResponseOrError :: Status -> (Element -> Maybe a) -> QueryResponse -> Either TableError a
+parseXmlResponseOrError status parse (QueryResponse rspStatus rspBody) =
+  let xmlDoc = parseXMLDoc rspBody in
+  if rspStatus == status
+  then
+    maybe (Left TableUnknownError) Right $ xmlDoc >>= parse
+  else
+    Left $ parseError xmlDoc
+
+-- |
+-- Parses an entity column type and value
+--
+parseEntityColumn :: Bool -> String -> String -> Maybe EntityColumn
+parseEntityColumn True  "Edm.Binary"   _        = Just $ EdmBinary Nothing
+parseEntityColumn False "Edm.Binary"   val      = Just $ EdmBinary $ Just val
+parseEntityColumn True  "Edm.Boolean"  _        = Just $ EdmBoolean Nothing
+parseEntityColumn False "Edm.Boolean"  "true"   = Just $ EdmBoolean $ Just True
+parseEntityColumn False "Edm.Boolean"  "false"  = Just $ EdmBoolean $ Just False
+parseEntityColumn True  "Edm.DateTime" _        = Just $ EdmDateTime Nothing
+parseEntityColumn False "Edm.DateTime" val      = Just $ EdmDateTime $ Just $ readTime defaultTimeLocale atomDateFormat val
+parseEntityColumn True  "Edm.Double"   _        = Just $ EdmDouble Nothing
+parseEntityColumn False "Edm.Double"   val      = Just $ EdmDouble $ Just $ read val
+parseEntityColumn True  "Edm.Guid"     _        = Just $ EdmGuid Nothing
+parseEntityColumn False "Edm.Guid"     val      = Just $ EdmGuid $ Just val
+parseEntityColumn True  "Edm.Int32"    _        = Just $ EdmInt32 Nothing
+parseEntityColumn False "Edm.Int32"    val      = Just $ EdmInt32 $ Just $ read val
+parseEntityColumn True  "Edm.Int64"    _        = Just $ EdmInt64 Nothing
+parseEntityColumn False "Edm.Int64"    val      = Just $ EdmInt64 $ Just $ read val
+parseEntityColumn True  "Edm.String"   _        = Just $ EdmString Nothing
+parseEntityColumn False "Edm.String"   val      = Just $ EdmString $ Just val
 parseEntityColumn _     _              _        = Nothing
src/Network/TableStorage/Types.hs view
@@ -1,127 +1,169 @@--- |--- Data types used to construct the various web method requests. ----module Network.TableStorage.Types (-  AccountKey(..),-  Signature(..),-  AuthHeader(..),-  Account(..),-  SharedKeyAuth(..),-  EntityKey(..),-  EntityColumn(..),-  Entity(..),-  EntityQuery(..),-  ComparisonType(..),-  EntityFilter(..)-) where--import Data.Time ( UTCTime )-import Network.HTTP.Base ( RequestMethod )---- |--- The Base-64 encoded account secret key----newtype AccountKey = AccountKey { unAccountKey :: String } deriving (Show, Eq)---- |--- The type of authorization header signatures ----newtype Signature = Signature { unSignature :: String } deriving (Show, Eq)---- |--- The type of authorization headers ----newtype AuthHeader = AuthHeader { unAuthHeader :: String } deriving (Show, Eq)---- |--- Account information: host, port, secret key and account name ----data Account = Account -  { accountScheme         :: String-  , accountHost           :: String-  , accountPort           :: Int-  , accountKey            :: AccountKey-  , accountName           :: String-  , accountResourcePrefix :: String -  } deriving (Show, Eq)---- |--- The unencrypted content of the Shared Key authorization header ----data SharedKeyAuth = SharedKeyAuth -  { sharedKeyAuthVerb                  :: RequestMethod-  , sharedKeyAuthContentMD5            :: String-  , sharedKeyAuthContentType           :: String-  , sharedKeyAuthDate                  :: String-  , sharedKeyAuthCanonicalizedResource :: String-  } deriving (Show, Eq)---- |--- Uniquely identifies an entity in a table : a partition key and row key pair. ----data EntityKey = EntityKey -  { ekPartitionKey :: String-  , ekRowKey       :: String -  } deriving (Show, Eq)---- |--- Represents a column in an entity.--- --- The constructor used indicates the data type of the column represented.------ For certain operations, the type must match the type of data stored in the table.----data EntityColumn = -  EdmBinary (Maybe String) |-  EdmBoolean (Maybe Bool) |-  EdmDateTime (Maybe UTCTime) |-  EdmDouble (Maybe Double) |-  EdmGuid (Maybe String) |-  EdmInt32 (Maybe Int) |-  EdmInt64 (Maybe Int) |-  EdmString (Maybe String)-  deriving (Show, Eq)---- |--- An entity consists of a key and zero or more additional columns.----data Entity = Entity { entityKey     :: EntityKey,-                       entityColumns :: [(String, EntityColumn)] } deriving Show---- |--- An entity query consists of an optional filter and an optional number of entities to return.------ Projections are not currently supported. ----data EntityQuery = EntityQuery -  { eqPageSize :: Maybe Int-  , eqFilter   :: Maybe EntityFilter -  } deriving (Show, Eq)-                                 --- |--- The various comparisons supported in entity queries. ----data ComparisonType = -  Equal |-  GreaterThan | -  GreaterThanOrEqual | -  LessThan |-  LessThanOrEqual | -  NotEqual -  deriving (Show, Eq)-                                 --- |--- The data type of entity filters ----data EntityFilter = -  And [EntityFilter] | -  Or [EntityFilter] | -  Not EntityFilter | -  CompareBoolean String Bool |-  CompareDateTime String ComparisonType UTCTime |-  CompareDouble String ComparisonType Double |-  CompareGuid String String |-  CompareInt32 String ComparisonType Integer |-  CompareInt64 String ComparisonType Integer |-  CompareString String ComparisonType String+-- |
+-- Data types used to construct the various web method requests.
+--
+module Network.TableStorage.Types (
+  AccountKey(..),
+  Signature(..),
+  AuthHeader(..),
+  Account(..),
+  SharedKeyAuth(..),
+  EntityKey(..),
+  EntityColumn(..),
+  Entity(..),
+  EntityQuery(..),
+  ComparisonType(..),
+  EntityFilter(..),
+  QueryResponse(..),
+  TableStorage,
+  TableConf(..),
+  TableError(..)
+) where
+
+import Data.Time ( UTCTime )
+import Network.HTTP.Types
+import Network.HTTP.Conduit
+import Control.Monad.Reader
+import Control.Monad.Error
+
+-- |
+-- Monad stack and return type of operations on azure tables
+--
+type TableStorage = ErrorT TableError (ReaderT TableConf IO)
+
+-- |
+-- TableStorage configuration data
+--
+data TableConf = TableConf
+  { tableAccount :: Account
+  , httpManager :: Maybe Manager
+  , httpProxy   :: Maybe Proxy
+  }
+
+-- |
+-- Error type
+--
+data TableError = TableParseError
+                | TableUnknownError
+                | TableOtherError String
+
+instance Error TableError where
+  noMsg  = TableUnknownError
+  strMsg = TableOtherError
+
+instance Show TableError where
+  show TableParseError = "Unable to parse result"
+  show TableUnknownError = "Unknown table storage error"
+  show (TableOtherError msg) = msg
+
+-- |
+-- The Base-64 encoded account secret key
+--
+newtype AccountKey = AccountKey { unAccountKey :: String } deriving (Show, Eq)
+
+-- |
+-- The type of authorization header signatures
+--
+newtype Signature = Signature { unSignature :: String } deriving (Show, Eq)
+
+-- |
+-- The type of authorization headers
+--
+newtype AuthHeader = AuthHeader { unAuthHeader :: String } deriving (Show, Eq)
+
+-- |
+-- Account information: host, port, secret key and account name
+--
+data Account = Account
+  { accountScheme         :: String
+  , accountHost           :: String
+  , accountPort           :: Int
+  , accountKey            :: AccountKey
+  , accountName           :: String
+  , accountResourcePrefix :: String
+  } deriving (Show, Eq)
+
+-- |
+-- The unencrypted content of the Shared Key authorization header
+--
+data SharedKeyAuth = SharedKeyAuth
+  { sharedKeyAuthVerb                  :: Method
+  , sharedKeyAuthContentMD5            :: String
+  , sharedKeyAuthContentType           :: String
+  , sharedKeyAuthDate                  :: String
+  , sharedKeyAuthCanonicalizedResource :: String
+  } deriving (Show, Eq)
+
+-- |
+-- Uniquely identifies an entity in a table : a partition key and row key pair.
+--
+data EntityKey = EntityKey
+  { ekPartitionKey :: String
+  , ekRowKey       :: String
+  } deriving (Show, Eq)
+
+-- |
+-- Represents a column in an entity.
+--
+-- The constructor used indicates the data type of the column represented.
+--
+-- For certain operations, the type must match the type of data stored in the table.
+--
+data EntityColumn =
+  EdmBinary (Maybe String) |
+  EdmBoolean (Maybe Bool) |
+  EdmDateTime (Maybe UTCTime) |
+  EdmDouble (Maybe Double) |
+  EdmGuid (Maybe String) |
+  EdmInt32 (Maybe Int) |
+  EdmInt64 (Maybe Int) |
+  EdmString (Maybe String)
+  deriving (Show, Eq)
+
+-- |
+-- Exception handling type.
+--
+data QueryResponse = QueryResponse Status String
+
+-- |
+-- An entity consists of a key and zero or more additional columns.
+--
+data Entity = Entity { entityKey     :: EntityKey,
+                       entityColumns :: [(String, EntityColumn)] } deriving Show
+
+-- |
+-- An entity query consists of an optional filter and an optional number of entities to return.
+--
+-- Projections are not currently supported.
+--
+data EntityQuery = EntityQuery
+  { eqPageSize :: Maybe Int
+  , eqFilter   :: Maybe EntityFilter
+  } deriving (Show, Eq)
+
+-- |
+-- The various comparisons supported in entity queries.
+--
+data ComparisonType =
+  Equal |
+  GreaterThan |
+  GreaterThanOrEqual |
+  LessThan |
+  LessThanOrEqual |
+  NotEqual
+  deriving (Show, Eq)
+
+-- |
+-- The data type of entity filters
+--
+data EntityFilter =
+  And [EntityFilter] |
+  Or [EntityFilter] |
+  Not EntityFilter |
+  CompareBoolean String Bool |
+  CompareDateTime String ComparisonType UTCTime |
+  CompareDouble String ComparisonType Double |
+  CompareGuid String String |
+  CompareInt32 String ComparisonType Integer |
+  CompareInt64 String ComparisonType Integer |
+  CompareString String ComparisonType String
   deriving (Show, Eq)
src/Network/TableStorage/XML.hs view
@@ -1,37 +1,37 @@--- |--- Helper methods for working with XML -----module Network.TableStorage.XML (-  qualify, cDataText, namespaceAttr-) where--import Text.XML.Light.Types-    ( Content(Text),-      CDataKind(CDataText),-      CData(CData, cdData, cdLine, cdVerbatim),-      QName(..),-      Attr(..) )---- |--- Qualify a name for a specific namespace and/or prefix ----qualify :: Maybe String -> Maybe String -> String -> QName-qualify namespace prefix name = -  QName { qName = name,-          qURI = namespace,-          qPrefix = prefix }---- |--- Constructs a piece of content consisting of a single string.----cDataText :: String -> [Content]-cDataText content = [ Text CData { cdVerbatim = CDataText, cdData = content, cdLine = Nothing } ]---- |--- Constructs an xmlns attribute to be added to the document root  ----namespaceAttr :: String -> String -> Attr-namespaceAttr prefix uri =-  Attr { attrKey = qualify Nothing (Just "xmlns") prefix,+-- |
+-- Helper methods for working with XML
+--
+
+module Network.TableStorage.XML (
+  qualify, cDataText, namespaceAttr
+) where
+
+import Text.XML.Light.Types
+    ( Content(Text),
+      CDataKind(CDataText),
+      CData(CData, cdData, cdLine, cdVerbatim),
+      QName(..),
+      Attr(..) )
+
+-- |
+-- Qualify a name for a specific namespace and/or prefix
+--
+qualify :: Maybe String -> Maybe String -> String -> QName
+qualify namespace prefix name =
+  QName { qName = name,
+          qURI = namespace,
+          qPrefix = prefix }
+
+-- |
+-- Constructs a piece of content consisting of a single string.
+--
+cDataText :: String -> [Content]
+cDataText content = [ Text CData { cdVerbatim = CDataText, cdData = content, cdLine = Nothing } ]
+
+-- |
+-- Constructs an xmlns attribute to be added to the document root
+--
+namespaceAttr :: String -> String -> Attr
+namespaceAttr prefix uri =
+  Attr { attrKey = qualify Nothing (Just "xmlns") prefix,
          attrVal = uri }
tablestorage.cabal view
@@ -1,51 +1,59 @@-name:           tablestorage-version:        0.1.0.3-cabal-version:  >= 1.2-build-type:     Simple-author:         Phil Freeman <paf31-at-cantab.net>-stability:      experimental-maintainer:     Phil Freeman <paf31@cantab.net>-homepage:       http://github.com/paf31/tablestorage-category:       Web, Database, API-license:        BSD3-copyright:      (c) Phil Freeman 2012-data-files:     -                LICENSE, -                tablestorage.cabal-tested-with:    GHC==7.0.4-license-file:   LICENSE-synopsis:       Azure Table Storage REST API Wrapper-description:    -                A collection of functions to call the methods of the Azure Table Storage REST API from Haskell.-                Table and entity level functions are supported along with shared key authentication token generation, and error handling. -                Pagination and projections are currently not supported.--library-  hs-source-dirs:  src+name:           tablestorage
+version:        0.2.1.0
+cabal-version:  >= 1.2
+build-type:     Simple
+author:         Phil Freeman, Aaron Friel
+stability:      experimental
+maintainer:     Phil Freeman <paf31@cantab.net>
+homepage:       http://github.com/paf31/tablestorage
+category:       Web, Database, API
+license:        BSD3
+copyright:      (c) Phil Freeman, Aaron Friel 2012
+data-files:     
+                LICENSE, 
+                tablestorage.cabal
+tested-with:    GHC==7.0.4
+license-file:   LICENSE
+synopsis:       Azure Table Storage REST API Wrapper
+description:    
+                A collection of functions to call the methods of the Azure Table Storage REST API from Haskell.
+                Table and entity level functions are supported along with shared key authentication token generation, and error handling. 
+                Pagination and projections are currently not supported.
+
+library
+  ghc-options:     -W -Wall
+  hs-source-dirs:  src
   build-depends:   
                    base >= 4 && < 5,
                    SHA,
                    bytestring,
                    utf8-string,
                    base64-bytestring,
-                   HTTP,
+                   http-conduit >= 1.8.5,
+                   conduit,
+                   http-types,
                    network,
                    time,
                    xml,
                    old-locale,
-                   mtl
-  ghc-options:     -Wall-  exposed-modules: -                   Network.TableStorage,-                   Network.TableStorage.API,-                   Network.TableStorage.Auth,-                   Network.TableStorage.Development,-                   Network.TableStorage.Query,-                   Network.TableStorage.Types-  other-modules:   -                   Network.TableStorage.Atom,-                   Network.TableStorage.Format,-                   Network.TableStorage.Request,-                   Network.TableStorage.Response,-                   Network.TableStorage.XML-+                   mtl,
+                   transformers,
+                   crypto-api,
+                   cryptohash,
+                   HTTP,
+                   resourcet
+  ghc-options:     -Wall
+  exposed-modules: 
+                   Network.TableStorage,
+                   Network.TableStorage.API,
+                   Network.TableStorage.Auth,
+                   Network.TableStorage.Development,
+                   Network.TableStorage.Query,
+                   Network.TableStorage.Types
+  other-modules:   
+                   Network.TableStorage.Atom,
+                   Network.TableStorage.Format,
+                   Network.TableStorage.Request,
+                   Network.TableStorage.Response,
+                   Network.TableStorage.XML
+