diff --git a/minio-hs.cabal b/minio-hs.cabal index 8324776..a47495d 100644 --- a/minio-hs.cabal +++ b/minio-hs.cabal @@ -32,11 +32,13 @@ library , http-client , http-conduit , http-types + , memory , text , time default-language: Haskell2010 default-extensions: OverloadedStrings , NoImplicitPrelude + , MultiWayIf executable minio-hs-exe hs-source-dirs: app diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs index af5fe32..09f8e69 100644 --- a/src/Network/Minio/API.hs +++ b/src/Network/Minio/API.hs @@ -14,11 +14,23 @@ import Network.Minio.Data import Network.Minio.Data.Crypto import Network.Minio.Sign.V4 +runRequestDebug r mgr = do + print $ "runRequestDebug" + print $ NC.method r + print $ NC.secure r + print $ NC.host r + print $ NC.port r + print $ NC.path r + print $ NC.queryString r + print $ NC.requestHeaders r + -- print $ NC.requestBody r + NC.httpLbs r mgr + minioExecute :: MinioClient -> RequestInfo -> IO (Response LByteString) minioExecute mc ri = do mgr <- NC.newManager defaultManagerSettings finalHeaders <- signV4 mc updatedRI - NC.httpLbs (req finalHeaders) mgr + runRequestDebug (req finalHeaders) mgr where req h = NC.defaultRequest { NC.method = method ri diff --git a/src/Network/Minio/Data/Crypto.hs b/src/Network/Minio/Data/Crypto.hs index b429df3..a344eb1 100644 --- a/src/Network/Minio/Data/Crypto.hs +++ b/src/Network/Minio/Data/Crypto.hs @@ -2,16 +2,29 @@ module Network.Minio.Data.Crypto ( hashSHA256 , hmacSHA256 + , hmacSHA256RawBS + , digestToBS + , digestToBase16 ) where import Crypto.Hash (SHA256(..), hashWith, Digest) import Crypto.MAC.HMAC (hmac, HMAC(hmacGetDigest)) +import Data.ByteArray (ByteArrayAccess, convert) +import Data.ByteArray.Encoding (convertToBase, Base(Base16)) import Lib.Prelude hashSHA256 :: ByteString -> ByteString -hashSHA256 = show . hashWith SHA256 +hashSHA256 = convertToBase Base16 . hashWith SHA256 -hmacSHA256 :: ByteString -> ByteString -> ByteString -hmacSHA256 message key = - show (hmacGetDigest (hmac key message) :: Digest SHA256) +hmacSHA256 :: ByteString -> ByteString -> HMAC SHA256 +hmacSHA256 message key = hmac key message + +hmacSHA256RawBS :: ByteString -> ByteString -> ByteString +hmacSHA256RawBS message key = convert $ hmacSHA256 message key + +digestToBS :: ByteArrayAccess a => a -> ByteString +digestToBS = convert + +digestToBase16 :: ByteArrayAccess a => a -> ByteString +digestToBase16 = convertToBase Base16 diff --git a/src/Network/Minio/Data/Time.hs b/src/Network/Minio/Data/Time.hs index 35d8dba..d1fe5d3 100644 --- a/src/Network/Minio/Data/Time.hs +++ b/src/Network/Minio/Data/Time.hs @@ -4,6 +4,7 @@ module Network.Minio.Data.Time , awsTimeFormatBS , awsDateFormat , awsDateFormatBS + , awsParseTime ) where @@ -23,3 +24,6 @@ awsDateFormat = Time.formatTime Time.defaultTimeLocale "%Y%m%d" awsDateFormatBS :: UTCTime -> ByteString awsDateFormatBS = pack . awsDateFormat + +awsParseTime :: [Char] -> Maybe UTCTime +awsParseTime = Time.parseTimeM False Time.defaultTimeLocale "%Y%m%dT%H%M%SZ" diff --git a/src/Network/Minio/Sign/V4.hs b/src/Network/Minio/Sign/V4.hs index cc7da75..4fa0877 100644 --- a/src/Network/Minio/Sign/V4.hs +++ b/src/Network/Minio/Sign/V4.hs @@ -1,9 +1,15 @@ module Network.Minio.Sign.V4 ( signV4 + , signV4AtTime + , getScope + , getHeadersToSign + , getCanonicalRequest + , SignV4Data(..) ) where import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 import Data.ByteString.Char8 (pack) import Data.CaseInsensitive (mk) import qualified Data.CaseInsensitive as CI @@ -25,6 +31,35 @@ ignoredHeaders = Set.fromList $ map CI.foldedCase [ mk "User-Agent" ] +data SignV4Data = SignV4Data { + sv4SignTime :: UTCTime + , sv4Scope :: ByteString + , sv4CanonicalRequest :: ByteString + , sv4HeadersToSign :: [(ByteString, ByteString)] + , sv4InputHeaders :: [Header] + , sv4OutputHeaders :: [Header] + , sv4StringToSign :: ByteString + , sv4SigningKey :: ByteString + } deriving (Show) + +debugPrintSignV4Data :: SignV4Data -> IO () +debugPrintSignV4Data (SignV4Data t s cr h2s ih oh sts sk) = do + B8.putStrLn "SignV4Data:" + B8.putStr "Timestamp: " >> print t + B8.putStr "Scope: " >> B8.putStrLn s + B8.putStrLn "Canonical Request:" + B8.putStrLn cr + B8.putStr "Headers to Sign: " >> print h2s + B8.putStr "Input headers: " >> print ih + B8.putStr "Output headers: " >> print oh + B8.putStr "StringToSign: " >> B8.putStrLn sts + B8.putStr "SigningKey: " >> printBytes sk + B8.putStrLn "END of SignV4Data =========" + where + printBytes b = do + mapM_ (\x -> B.putStr $ B.concat [show x, " "]) $ B.unpack b + B8.putStrLn "" + -- | Given MinioClient and request details, including request method, -- request path, headers, query params and payload hash, generates an -- updated set of headers, including the x-amz-date header and the @@ -33,17 +68,22 @@ signV4 :: MinioClient -> RequestInfo -> IO [Header] signV4 mc ri = do timestamp <- Time.getCurrentTime - return $ signV4AtTime timestamp mc ri + let signData = signV4AtTime timestamp mc ri + debugPrintSignV4Data signData + return $ sv4OutputHeaders signData -- | Takes a timestamp, server params and request params and generates -- an updated list of headers. -signV4AtTime :: UTCTime -> MinioClient -> RequestInfo -> [Header] -signV4AtTime ts mc ri = authHeader : headersWithDate +signV4AtTime :: UTCTime -> MinioClient -> RequestInfo -> SignV4Data +signV4AtTime ts mc ri = + SignV4Data ts scope canonicalRequest headersToSign (headers ri) outHeaders stringToSign signingKey where + outHeaders = authHeader : headersWithDate timeBS = awsTimeFormatBS ts dateHeader = (mk "X-Amz-Date", timeBS) + hostHeader = (mk "host", encodeUtf8 $ mcEndPointHost mc) - headersWithDate = dateHeader : (headers ri) + headersWithDate = dateHeader : hostHeader : (headers ri) authHeader = (mk "Authorization", authHeaderValue) @@ -51,7 +91,7 @@ signV4AtTime ts mc ri = authHeader : headersWithDate authHeaderValue = B.concat [ "AWS4-HMAC-SHA256 Credential=", - scope, + encodeUtf8 (mcAccessKey mc), "/", scope, ", SignedHeaders=", signedHeaders, ", Signature=", signature ] @@ -60,12 +100,12 @@ signV4AtTime ts mc ri = authHeader : headersWithDate signedHeaders = B.intercalate ";" $ map fst headersToSign - signature = hmacSHA256 stringToSign signingKey + signature = digestToBase16 $ hmacSHA256 stringToSign signingKey - signingKey = hmacSHA256 "aws4_request" - . hmacSHA256 "s3" - . hmacSHA256 (encodeUtf8 $ mcRegion mc) - . hmacSHA256 timeBS + signingKey = hmacSHA256RawBS "aws4_request" + . hmacSHA256RawBS "s3" + . hmacSHA256RawBS (encodeUtf8 $ mcRegion mc) + . hmacSHA256RawBS (awsDateFormatBS ts) $ (B.concat ["AWS4", encodeUtf8 $ mcSecretKey mc]) stringToSign = B.intercalate "\n" $ @@ -80,7 +120,6 @@ signV4AtTime ts mc ri = authHeader : headersWithDate getScope :: UTCTime -> MinioClient -> ByteString getScope ts mc = B.intercalate "/" $ [ - encodeUtf8 (mcAccessKey mc), pack $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts, "us-east-1", "s3", "aws4_request" ] @@ -99,15 +138,10 @@ getCanonicalRequest ri headersForSign = B.intercalate "\n" $ [ canonicalQueryString, canonicalHeaders, signedHeaders, - payloadHash ri, - "" + payloadHash ri ] where - path = B.concat $ - maybe [] (\bkt -> bkt : ( - maybe [] (\obj -> - ["/", encodeUtf8 $ obj]) $ object ri)) $ - bucket ri + path = getPathFromRI ri canonicalQueryString = B.intercalate "&" $ map (\(x, y) -> B.concat [x, "=", y]) $