Signing works! But includes lots of debug stmts.

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

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

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

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"

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]) $