tablestorage 0.1.0.2 → 0.1.0.3

raw patch · 11 files changed

+393/−234 lines, 11 filesdep +mtlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: mtl

API changes (from Hackage documentation)

Files

• src/Network/TableStorage/API.hs +46/−25
• src/Network/TableStorage/Atom.hs +13/−2
• src/Network/TableStorage/Auth.hs +71/−45
• src/Network/TableStorage/Development.hs +5/−2
• src/Network/TableStorage/Format.hs +6/−3
• src/Network/TableStorage/Query.hs +84/−78
• src/Network/TableStorage/Request.hs +86/−30
• src/Network/TableStorage/Response.hs +14/−8
• src/Network/TableStorage/Types.hs +44/−25
• src/Network/TableStorage/XML.hs +8/−1
• tablestorage.cabal +16/−15

@@ -9,15 +9,41 @@ ) where  import Network.HTTP+    ( HeaderName(HdrCustom),+      Header(Header),+      RequestMethod(Custom, DELETE, GET, POST, PUT),+      Response_String ) import Text.XML.Light-import Text.Printf+    ( Element(elName),+      QName(qName, qURI),+      showTopElement,+      filterChildren,+      findAttr,+      findChild,+      findChildren,+      strContent ) import Network.TableStorage.Types-import Network.TableStorage.Auth+    ( 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-import Data.Time.Clock (getCurrentTime)-import Data.Maybe (fromMaybe)+    ( 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@@ -28,11 +54,11 @@   readTables feed = sequence $ do     entry <- findChildren (qualifyAtom "entry") feed     return $ readTableName entry-  readTableName entry = do-    content <- findChild (qualifyAtom "content") entry-    properties <- findChild (qualifyMetadata "properties") content-    tableName <- findChild (qualifyDataServices "TableName") properties-    return $ strContent tableName+  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@@ -63,23 +89,16 @@ -- 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 = do -  tables <- queryTables acc-  case tables of-    Left err -> return $ Left err-    Right tables' -> -      if any (== tableName) tables'-      then-        return $ Right ()-      else -        createTable acc tableName+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 = printf "/Tables('%s')" tableName+  let resource = "/Tables('" ++ tableName ++ "')"    response <- authenticatedRequest acc DELETE [] resource resource ""   return $ response >>= parseEmptyResponse (2, 0, 4) @@ -100,7 +119,7 @@ -- insertEntity :: Account -> String -> Entity -> IO (Either String ()) insertEntity acc tableName entity = do -  let resource = printf "/%s" tableName+  let resource = '/' : tableName   requestXml <- createInsertEntityXml entity   response <- authenticatedRequest acc POST [] resource resource $ showTopElement requestXml   return $ response >>= parseEmptyResponse (2, 0, 1)  @@ -144,8 +163,10 @@ -- readEntity :: Element -> Maybe Entity readEntity entry = do-    content <- findChild (qualifyAtom "content") entry-    properties <- findChild (qualifyMetadata "properties") content+    properties <- +      findChild (qualifyAtom "content")+      >=> findChild (qualifyMetadata "properties")+      $ entry     partitionKey <- findChild (qualifyDataServices "PartitionKey") properties     rowKey <- findChild (qualifyDataServices "RowKey") properties     let columnData = filterChildren filterProperties properties@@ -192,9 +213,9 @@ -- queryEntities :: Account -> String -> EntityQuery -> IO (Either String [Entity]) queryEntities acc tableName query = do -  let canonicalizedResource = printf "/%s()" tableName+  let canonicalizedResource = '/' : tableName ++ "()"   let queryString = buildQueryString query-  let resource = printf "%s?%s" canonicalizedResource queryString+  let resource = canonicalizedResource ++ '?' : queryString   response <- authenticatedRequest acc GET [] resource canonicalizedResource ""   return $ response >>= parseQueryEntitiesResponse   

@@ -3,11 +3,22 @@ -- request and response bodies of the various web methods. -- -module Network.TableStorage.Atom where+module Network.TableStorage.Atom (+  atomNamespace, dataServicesNamespace, metadataNamespace,+  qualifyAtom, qualifyDataServices, qualifyMetadata,+  atomElement, atomAttr, wrapContent+) where  import Network.TableStorage.XML-import Network.TableStorage.Format+    ( 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"

@@ -10,22 +10,38 @@   authenticatedRequest ) where -import qualified Data.ByteString.Base64 as Base64C ( encode, decode )+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+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-import Network.HTTP.Base ( )+    ( 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-import Network.TableStorage.Format-import Text.Printf ( printf )+    ( SharedKeyAuth(..),+      Account(accountHost, accountKey, accountName, accountPort,+              accountResourcePrefix, accountScheme),+      AuthHeader(..),+      Signature(..),+      AccountKey(unAccountKey) )+import Network.TableStorage.Format ( rfc1123Date )  authenticationType :: String authenticationType = "SharedKey"@@ -34,46 +50,53 @@ -- Constructs the unencrypted content of the Shared Key authentication token  -- printSharedKeyAuth :: SharedKeyAuth -> String-printSharedKeyAuth auth = printf "%s\n%s\n%s\n%s\n%s"-  (show (sharedKeyAuthVerb auth))-  (sharedKeyAuthContentMD5 auth)-  (sharedKeyAuthContentType auth)-  (sharedKeyAuthDate auth)-  (sharedKeyAuthCanonicalizedResource auth)-+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 base64Key in+  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 = UTF8.toString . Base64C.encode . hmacSha256' key . UTF8C.encodeString . printSharedKeyAuth+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 = printf "%s %s:%s"+authHeader acc auth = AuthHeader $   authenticationType -  (accountName acc) -  (signature (accountKey acc) auth)+  ++ " " +  ++ 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 }+  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.@@ -86,20 +109,23 @@ 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 = printf "/%s%s%s" (accountName acc) (accountResourcePrefix acc) canonicalizedResource }-  let basicHeaders = [ Header HdrAuthorization (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 }+  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

@@ -2,9 +2,12 @@ -- This module contains constants for working with the storage emulator.   -- -module Network.TableStorage.Development where+module Network.TableStorage.Development (+  developmentAccount+) where  import Network.TableStorage.Types+    ( Account(..), AccountKey(AccountKey) )  -- | -- An account for the storage emulator@@ -15,4 +18,4 @@                                accountName              = "devstoreaccount1",                                accountPort              = 10002,                                accountResourcePrefix    = "/devstoreaccount1",-                               accountKey               = "Eby8vdM02xNOcqFlqUwJPLlmEtlCDXJ1OUzFT50uSRZ6IFsuFq2UVErCz4I6tq/K1SZFPTOtr/KBHBeksoGMGw=="}+                               accountKey               = AccountKey "Eby8vdM02xNOcqFlqUwJPLlmEtlCDXJ1OUzFT50uSRZ6IFsuFq2UVErCz4I6tq/K1SZFPTOtr/KBHBeksoGMGw=="}

@@ -2,10 +2,13 @@ -- Helper methods for working with formatted dates -- -module Network.TableStorage.Format where+module Network.TableStorage.Format (+  getFormattedTime, rfc1123Date, atomDate,  +  rfc1123Format, atomDateFormat+) where -import Data.Time-import System.Locale+import Data.Time ( getCurrentTime, formatTime )+import System.Locale ( defaultTimeLocale )  getFormattedTime :: String -> IO String getFormattedTime formatString = fmap (formatTime defaultTimeLocale formatString) getCurrentTime

@@ -1,79 +1,85 @@--- |
--- This module contains functions which help when unmarshalling query responses
-
-module Network.TableStorage.Query where
-
-import Data.Time
-import Network.TableStorage.Types
-
--- |
--- 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

@@ -2,20 +2,37 @@ -- Helper methods used to construct requests. -- -module Network.TableStorage.Request where+module Network.TableStorage.Request (+  propertyList,+  entityKeyResource,+  columnToTypeString,+  printEntityColumn,+  printComparisonType,+  buildFilterString,+  buildQueryString+) where -import Data.Time-import System.Locale-import Data.Maybe (fromMaybe)-import Data.List (intercalate)-import Text.XML.Light.Types (elAttribs)+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-import Network.TableStorage.XML+    ( EntityFilter(..),+      ComparisonType(..),+      EntityQuery(eqFilter, eqPageSize),+      EntityColumn(..),+      EntityKey(ekPartitionKey, ekRowKey) )+import Network.TableStorage.XML ( cDataText ) import Network.TableStorage.Atom-import Network.TableStorage.Format-import Network.HTTP.Base-import Text.Printf (printf)+    ( qualifyDataServices, qualifyMetadata )+import Network.TableStorage.Format ( atomDateFormat )+import Network.HTTP.Base ( urlEncode )  -- | -- Formats a list of entity properties for inclusion in an Atom entry. @@ -36,10 +53,7 @@ -- and entity key.  -- entityKeyResource :: String -> EntityKey -> String-entityKeyResource tableName key = printf "%s(PartitionKey='%s',RowKey='%s')" -  tableName -  (ekPartitionKey key) -  (ekRowKey key)+entityKeyResource tableName key = tableName ++ "(PartitionKey='" ++ ekPartitionKey key ++ "',RowKey='" ++ ekRowKey key ++ "')"  -- | -- Converts an entity column into its type name@@ -62,13 +76,16 @@ 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 $ printf "%f" val+printEntityColumn (EdmDouble (Just val))       = Just $ show val printEntityColumn (EdmGuid (Just val))         = Just val-printEntityColumn (EdmInt32 (Just val))        = Just $ printf "%d" val-printEntityColumn (EdmInt64 (Just val))        = Just $ printf "%d" 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"@@ -82,21 +99,60 @@ -- portion of the Query Entities URI.  -- buildFilterString :: EntityFilter -> String-buildFilterString (And fs) = printf "(%s)" $ intercalate "%%20and%%20" $ map buildFilterString fs-buildFilterString (Or fs) = printf "(%s)" $ intercalate "%%20or%%20" $ map buildFilterString fs-buildFilterString (Not f) = "(not%%20" ++ buildFilterString f ++ ")"-buildFilterString (CompareBoolean prop val) = printf "%s%%20eq%%20%s" (urlEncode prop) (if val then "true" else "false")-buildFilterString (CompareDateTime prop cmp val) = printf "%s%%20%s%%20datetime'%s'" (urlEncode prop) (printComparisonType cmp) (formatTime defaultTimeLocale atomDateFormat val)-buildFilterString (CompareDouble prop cmp val) = printf "%s%%20%s%%20%f" (urlEncode prop) (printComparisonType cmp) val-buildFilterString (CompareGuid prop val) = printf "%s%%20eq%%20guid'%s'" (urlEncode prop) val-buildFilterString (CompareInt32 prop cmp val) = printf "%s%%20%s%%20%d" (urlEncode prop) (printComparisonType cmp) val-buildFilterString (CompareInt64 prop cmp val) = printf "%s%%20%s%%20%d" (urlEncode prop) (printComparisonType cmp) val-buildFilterString (CompareString prop cmp val) = printf "%s%%20%s%%20'%s'" (urlEncode prop) (printComparisonType cmp) (urlEncode val)+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 = printf "$filter=%s&$top=%s"-  (maybe "" buildFilterString $ eqFilter query)-  (maybe "" show $ eqPageSize query)+buildQueryString query = +  "$filter="+  ++ maybe "" buildFilterString (eqFilter query) +  ++ "&$top=" +  ++ maybe "" show (eqPageSize query)  

@@ -2,17 +2,23 @@ -- Helper methods for parsing web method response bodies.  -- -module Network.TableStorage.Response where+module Network.TableStorage.Response (+  parseError, errorToString,+  parseEmptyResponse, parseXmlResponseOrError,+  parseEntityColumn+) where -import Data.Time-import System.Locale+import Data.Time ( readTime )+import System.Locale ( defaultTimeLocale ) import Text.XML.Light-import Control.Monad (guard)-import Data.Maybe (fromMaybe)-import Network.TableStorage.Atom-import Network.TableStorage.Types-import Network.TableStorage.Format+    ( 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 

@@ -1,51 +1,68 @@ -- | -- Data types used to construct the various web method requests.  ----module Network.TableStorage.Types where+module Network.TableStorage.Types (+  AccountKey(..),+  Signature(..),+  AuthHeader(..),+  Account(..),+  SharedKeyAuth(..),+  EntityKey(..),+  EntityColumn(..),+  Entity(..),+  EntityQuery(..),+  ComparisonType(..),+  EntityFilter(..)+) where -import Data.Time-import Network.HTTP.Base+import Data.Time ( UTCTime )+import Network.HTTP.Base ( RequestMethod )  -- | -- The Base-64 encoded account secret key ---type AccountKey = String+newtype AccountKey = AccountKey { unAccountKey :: String } deriving (Show, Eq)  -- | -- The type of authorization header signatures  ---type Signature = String+newtype Signature = Signature { unSignature :: String } deriving (Show, Eq)  -- | -- The type of authorization headers  ---type AuthHeader = String+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               +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+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+data EntityKey = EntityKey +  { ekPartitionKey :: String+  , ekRowKey       :: String +  } deriving (Show, Eq)  -- | -- Represents a column in an entity.@@ -63,7 +80,7 @@   EdmInt32 (Maybe Int) |   EdmInt64 (Maybe Int) |   EdmString (Maybe String)-  deriving Show+  deriving (Show, Eq)  -- | -- An entity consists of a key and zero or more additional columns.@@ -76,8 +93,10 @@ -- -- Projections are not currently supported.  ---data EntityQuery = EntityQuery { eqPageSize :: Maybe Int,-                                 eqFilter   :: Maybe EntityFilter } deriving Show+data EntityQuery = EntityQuery +  { eqPageSize :: Maybe Int+  , eqFilter   :: Maybe EntityFilter +  } deriving (Show, Eq)                                   -- | -- The various comparisons supported in entity queries. @@ -89,7 +108,7 @@   LessThan |   LessThanOrEqual |    NotEqual -  deriving Show+  deriving (Show, Eq)                                   -- | -- The data type of entity filters @@ -105,4 +124,4 @@   CompareInt32 String ComparisonType Integer |   CompareInt64 String ComparisonType Integer |   CompareString String ComparisonType String-  deriving Show+  deriving (Show, Eq)

@@ -2,9 +2,16 @@ -- Helper methods for working with XML  -- -module Network.TableStorage.XML where+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 

@@ -1,5 +1,5 @@ name:           tablestorage-version:        0.1.0.2+version:        0.1.0.3 cabal-version:  >= 1.2 build-type:     Simple author:         Phil Freeman <paf31-at-cantab.net>@@ -32,19 +32,20 @@                    network,
                    time,
                    xml,
-                   old-locale
+                   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
+  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