diff --git a/Network/HTTP/Rest/Signature/EC2.hs b/Network/HTTP/Rest/Signature/EC2.hs --- a/Network/HTTP/Rest/Signature/EC2.hs +++ b/Network/HTTP/Rest/Signature/EC2.hs @@ -16,86 +16,4 @@ , signature' ) where -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.ByteString.Char8 () -import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Base64 as Base64 -import qualified Data.Digest.Pure.SHA as SHA -import Data.List -import Data.Map (Map) -import qualified Data.Map as Map -import Data.Monoid -import qualified Network.HTTP.Types as HTTP - --- | A query string for HTTP. --- --- > "param1=value1¶m2=value2" -data QueryString = QueryString { toString :: ByteString } - deriving (Eq) - -type Method = ByteString -type Endpoint = ByteString -type Path = ByteString -type SecretKey = ByteString -data SignatureMethod = HmacSHA256 - --- | Convert a parameter list to 'QueryString'. --- --- ex: --- --- > queryString [("param1", "value1"), ("param2", "value2)] --> "param1=value1¶m2=value2" -queryString :: [(ByteString, ByteString)] -> QueryString -queryString = queryString' . sort - --- | Convert a parameter map to 'QueryString'. -queryStringFromMap :: Map ByteString ByteString -> QueryString -queryStringFromMap = queryString' . Map.toList - -queryString' :: [(ByteString, ByteString)] -> QueryString -queryString' = QueryString . BS.intercalate "&" . map concatWithEqual - where - concatWithEqual (key, val) = mconcat - [ key - , "=" - , HTTP.urlEncode True val - ] - --- | Make a string for making signature. --- --- ex: --- --- > GET --- > ec2.amazonaws.com --- > / --- > Action=DescribeInstances&AWSAccessKeyId=xxx&... -stringToSign :: Method -> Endpoint -> Path -> [(ByteString, ByteString)] -> ByteString -stringToSign method end path = stringToSign' method end path . queryString - -stringToSign' :: Method -> Endpoint -> Path -> QueryString -> ByteString -stringToSign' method end path params = BS.intercalate "\n" - [ method - , end - , path - , toString params - ] - --- | Make signature from a parameter list. -signature :: Method -> Endpoint -> Path -> SecretKey -> SignatureMethod -> [(ByteString, ByteString)] -> ByteString -signature method end path secret sigm - = signature' method end path secret sigm . queryString - --- | Make signature from a 'QueryString'. -signature' :: Method -> Endpoint -> Path -> SecretKey -> SignatureMethod -> QueryString -> ByteString -signature' method end path secret sigm params - = HTTP.urlEncode True - $ Base64.encode - $ signedString sigm - where - strToSign = stringToSign' method end path params - signedString HmacSHA256 - = mconcat - $ BL.toChunks - $ SHA.bytestringDigest - $ SHA.hmacSha256 (toL secret) (toL strToSign) - toL = BL.fromChunks . (:[]) +import Network.HTTP.Rest.Signature.EC2.Internal diff --git a/Network/HTTP/Rest/Signature/EC2/Internal.hs b/Network/HTTP/Rest/Signature/EC2/Internal.hs new file mode 100644 --- /dev/null +++ b/Network/HTTP/Rest/Signature/EC2/Internal.hs @@ -0,0 +1,93 @@ +module Network.HTTP.Rest.Signature.EC2.Internal where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.ByteString.Char8 () +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Base64 as Base64 +import qualified Data.Digest.Pure.SHA as SHA +import Data.List +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Monoid +import qualified Network.HTTP.Types as HTTP + +-- | A query string for HTTP. +-- +-- > "param1=value1¶m2=value2" +data QueryString = + QueryString { rawData :: [(ByteString, ByteString)] } + deriving (Eq) + +instance Monoid QueryString where + mempty = QueryString [] + mappend a b = QueryString $ rawData a `merge` rawData b + +merge :: Ord a => [a] -> [a] -> [a] +merge [] bs = bs +merge as [] = as +merge (a:as) (b:bs) + | a <= b = a:merge as (b:bs) + | otherwise = b:merge (a:as) bs + +type Method = ByteString +type Endpoint = ByteString +type Path = ByteString +type SecretKey = ByteString +data SignatureMethod = HmacSHA256 + +-- | Convert a parameter list to 'QueryString'. +-- +-- >>> toString $ queryString [("param1", "value1"), ("param2", "value2")] +-- "param1=value1¶m2=value2" +queryString :: [(ByteString, ByteString)] -> QueryString +queryString = QueryString . sort + +-- | Convert a parameter map to 'QueryString'. +queryStringFromMap :: Map ByteString ByteString -> QueryString +queryStringFromMap = queryString . Map.toList + +toString :: QueryString -> ByteString +toString = BS.intercalate "&" . map concatWithEqual . rawData + where + concatWithEqual ("", _) = error "name is null." + concatWithEqual (key, val) = mconcat + [ HTTP.urlEncode True key + , "=" + , HTTP.urlEncode True val + ] + +-- | Make a string for making signature. +-- +-- >>> stringToSign "GET" "ec2.amazonaws.com" "/" [("key1", "value1"), ("key2", "value2")] +-- "GET\nec2.amazonaws.com\n/\nkey1=value1&key2=value2" +stringToSign :: Method -> Endpoint -> Path -> [(ByteString, ByteString)] -> ByteString +stringToSign method end path = stringToSign' method end path . queryString + +stringToSign' :: Method -> Endpoint -> Path -> QueryString -> ByteString +stringToSign' method end path params = BS.intercalate "\n" + [ method + , end + , path + , toString params + ] + +-- | Make signature from a parameter list. +signature :: Method -> Endpoint -> Path -> SecretKey -> SignatureMethod -> [(ByteString, ByteString)] -> ByteString +signature method end path secret sigm + = signature' method end path secret sigm . queryString + +-- | Make signature from a 'QueryString'. +signature' :: Method -> Endpoint -> Path -> SecretKey -> SignatureMethod -> QueryString -> ByteString +signature' method end path secret sigm params + = HTTP.urlEncode True + $ Base64.encode + $ signedString sigm + where + strToSign = stringToSign' method end path params + signedString HmacSHA256 + = mconcat + $ BL.toChunks + $ SHA.bytestringDigest + $ SHA.hmacSha256 (toL secret) (toL strToSign) + toL = BL.fromChunks . (:[]) diff --git a/ec2-signature.cabal b/ec2-signature.cabal --- a/ec2-signature.cabal +++ b/ec2-signature.cabal @@ -1,5 +1,5 @@ name: ec2-signature -version: 1.0 +version: 2.0 synopsis: The Amazon EC2 style signature calculator. description: The Amazon EC2 style signature calculator. @@ -15,6 +15,7 @@ library exposed-modules: Network.HTTP.Rest.Signature.EC2 + other-modules: Network.HTTP.Rest.Signature.EC2.Internal extensions: OverloadedStrings ghc-options: -Wall -fno-warn-unused-do-bind build-depends: base == 4.* @@ -24,6 +25,30 @@ , SHA , http-types +test-suite doctest + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Doctest.hs + ghc-options: -Wall + build-depends: base == 4.* + , doctest + +test-suite spec + type: exitcode-stdio-1.0 + hs-source-dirs: ., test + main-is: Spec.hs + ghc-options: -Wall + extensions: OverloadedStrings + build-depends: base == 4.* + , bytestring + , base64-bytestring + , containers + , SHA + , http-types + , hspec + , QuickCheck + , bytestring + source-repository head type: git - location: git://github.com/yunomu/ec2-signature.git + location: git://github.com/worksap-ate/ec2-signature.git diff --git a/test/Doctest.hs b/test/Doctest.hs new file mode 100644 --- /dev/null +++ b/test/Doctest.hs @@ -0,0 +1,9 @@ +module Main where + +import Test.DocTest + +main :: IO () +main = doctest + [ "-XOverloadedStrings" + , "Network/HTTP/Rest/Signature/EC2.hs" + ] diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,35 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +import Control.Applicative +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BC +import Data.Monoid +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck + +import Network.HTTP.Rest.Signature.EC2.Internal + +instance Arbitrary ByteString where + arbitrary = BC.pack <$> arbitrary + +data KeyString = Key { unpack :: ByteString } + +instance Arbitrary KeyString where + arbitrary = Key . BC.pack <$> ((:) <$> arbitrary <*> arbitrary) + +instance Arbitrary QueryString where + arbitrary = queryString . map f <$> arbitrary + where + f (a, b) = (unpack a, b) + +instance Show QueryString where + show = show . rawData + +main :: IO () +main = hspec $ do + describe "QueryString" $ do + prop "mappend" prop_mappend + +prop_mappend :: QueryString -> QueryString -> Bool +prop_mappend a b = (a <> b) == queryString (rawData a ++ rawData b)