Compiling but without signing working properly yet

app/Main.hs

@@ -1,7 +1,19 @@
 module Main where
 
+import qualified Network.HTTP.Types as HT
+import qualified Network.HTTP.Conduit as NC
+
 import Protolude
-import Lib
+
+import Network.Minio.API
+import Network.Minio.Data
 
 main :: IO ()
-main = someFunc
+main = do
+  resp <- minioExecute mc req
+  print $ NC.responseStatus resp
+  print $ NC.responseHeaders resp
+  print $ NC.responseBody resp
+  where
+    mc = MinioClient "localhost" 9000 "abcd1" "abcd1234" False "us-east-1"
+    req = RequestInfo HT.methodGet Nothing Nothing [] [] "" ""

minio-hs.cabal

@@ -1,8 +1,8 @@
-name:                minio-client
+name:                minio-hs
 version:             0.1.0.0
 synopsis:            Initial project template from stack
 description:         Please see README.md
-homepage:            https://github.com/donatello/minio-client#readme
+homepage:            https://github.com/donatello/minio-hs#readme
 license:             BSD3
 license-file:        LICENSE
 author:              Aditya Manthramurthy
@@ -16,32 +16,46 @@ cabal-version:       >=1.10
 library
   hs-source-dirs:      src
   ghc-options:         -Wall
-  exposed-modules:     Lib
+  exposed-modules:     Network.Minio.Data
+                     , Network.Minio.Data.ByteString
+                     , Network.Minio.Data.Crypto
+                     , Network.Minio.Data.Time
+                     , Network.Minio.Sign.V4
+                     , Network.Minio.API
   other-modules:       Lib.Prelude
   build-depends:       base >= 4.7 && < 5
                      , protolude >= 0.1.6 && < 0.2
                      , bytestring
+                     , case-insensitive
+                     , containers
                      , cryptonite
+                     , http-client
+                     , http-conduit
+                     , http-types
                      , text
+                     , time
   default-language:    Haskell2010
-  default-extensions:  OverloadedStrings, NoImplicitPrelude
+  default-extensions:  OverloadedStrings
+                     , NoImplicitPrelude
 
-executable minio-client-exe
+executable minio-hs-exe
   hs-source-dirs:      app
   main-is:             Main.hs
   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N
   build-depends:       base
-                     , minio-client
+                     , minio-hs
                      , protolude >= 0.1.6 && < 0.2
+                     , http-conduit
+                     , http-types
   default-language:    Haskell2010
   default-extensions:  OverloadedStrings, NoImplicitPrelude
 
-test-suite minio-client-test
+test-suite minio-hs-test
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test
   main-is:             Spec.hs
   build-depends:       base
-                     , minio-client
+                     , minio-hs
                      , protolude >= 0.1.6 && < 0.2
   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010
@@ -49,4 +63,4 @@ test-suite minio-client-test
 
 source-repository head
   type:     git
-  location: https://github.com/donatello/minio-client
+  location: https://github.com/donatello/minio-hs

src/Lib.hs

@@ -1,55 +0,0 @@
-{-|
-Module      : Lib
-Description : Lib's main module
-
-This is a haddock comment describing your library
-For more information on how to write Haddock comments check the user guide:
-<https://www.haskell.org/haddock/doc/html/index.html>
--}
-module Lib
-    ( someFunc
-    , hmacSha256
-    , sha256Hash
-    ) where
-
-import Lib.Prelude
-
-import Crypto.Hash (SHA256, Digest, hash)
-import Crypto.MAC.HMAC (hmac, HMAC(hmacGetDigest))
-
--- | Prints someFunc
---
--- >>> someFunc 10
--- someFunc
-someFunc :: IO ()
-someFunc = putStrLn ("someFunc" :: Text)
-
-hmacSha256 :: ByteString -> ByteString -> ByteString
-hmacSha256 key message =
-  show (hmacGetDigest (hmac key message) :: Digest SHA256)
-
-sha256Hash :: ByteString -> ByteString
-sha256Hash payload = show (hash payload :: Digest SHA256)
-
-{-
-
-
-public static String UriEncode(CharSequence input, boolean encodeSlash) {
-          StringBuilder result = new StringBuilder();
-          for (int i = 0; i < input.length(); i++) {
-              char ch = input.charAt(i);
-              if ((ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') ||
-                  (ch >= '0' && ch <= '9') || ch == '_' || ch == '-' || ch == '~' || ch == '.') {
-                  result.append(ch);
-              } else if (ch == '/') {
-                  result.append(encodeSlash ? "%2F" : ch);
-              } else {
-                  result.append(toHexUTF8(ch));
-              }
-          }
-          return result.toString();
-      }
-ch 65536 -> %10000
--}
-uriEncode :: Text -> Bool -> ByteString
-uriEncode payload encodeSlash = 

src/Lib/Prelude.hs

@@ -9,3 +9,5 @@ module Lib.Prelude
     ) where
 
 import Protolude as Exports
+
+import Data.Time as Exports (UTCTime)

src/Network/Minio/API.hs

@@ -0,0 +1,38 @@
+module Network.Minio.API
+  (
+    minioExecute
+  ) where
+
+import           Network.HTTP.Client (defaultManagerSettings)
+import qualified Network.HTTP.Types as HT
+import           Network.HTTP.Conduit (Response)
+import qualified Network.HTTP.Conduit as NC
+
+import           Lib.Prelude
+
+import           Network.Minio.Data
+import           Network.Minio.Data.Crypto
+import           Network.Minio.Sign.V4
+
+minioExecute :: MinioClient -> RequestInfo -> IO (Response LByteString)
+minioExecute mc ri = do
+  mgr <- NC.newManager defaultManagerSettings
+  finalHeaders <- signV4 mc updatedRI
+  NC.httpLbs (req finalHeaders) mgr
+  where
+    req h = NC.defaultRequest {
+        NC.method         = method ri
+      , NC.secure         = mcIsSecure mc
+      , NC.host           = encodeUtf8 $ mcEndPointHost mc
+      , NC.port           = mcEndPointPort mc
+      , NC.path           = getPathFromRI ri
+      , NC.queryString    = HT.renderQuery False $ queryParams ri
+      , NC.requestHeaders = h
+      , NC.requestBody    = NC.RequestBodyBS (payload ri)
+      }
+
+    phash = hashSHA256 $ payload ri
+    updatedRI = ri {
+        payloadHash = phash
+      , headers = ("x-amz-content-sha256", phash) : (headers ri)
+      }

src/Network/Minio/Data.hs

@@ -0,0 +1,41 @@
+module Network.Minio.Data
+  (
+    MinioClient(..)
+  , RequestInfo(..)
+  , Bucket
+  , Object
+  , getPathFromRI
+  ) where
+
+import qualified Data.ByteString as B
+import           Network.HTTP.Types (Method, Header, Query)
+
+import           Lib.Prelude
+
+data MinioClient = MinioClient {
+    mcEndPointHost :: Text
+  , mcEndPointPort :: Int
+  , mcAccessKey :: Text
+  , mcSecretKey :: Text
+  , mcIsSecure :: Bool
+  , mcRegion :: Text
+  } deriving (Eq, Show)
+
+type Bucket = ByteString
+type Object = Text
+
+data RequestInfo = RequestInfo {
+    method :: Method
+  , bucket :: Maybe Bucket
+  , object :: Maybe Object
+  , queryParams :: Query
+  , headers :: [Header]
+  , payload :: ByteString
+  , payloadHash :: ByteString
+  }
+
+getPathFromRI :: RequestInfo -> ByteString
+getPathFromRI ri = B.concat $ parts
+  where
+    objPart = maybe [] (\o -> ["/", encodeUtf8 o]) $ object ri
+    parts = maybe ["/"] (\b -> "/" : b : objPart) $ bucket ri

src/Network/Minio/Data/ByteString.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE FlexibleInstances #-}
+module Network.Minio.Data.ByteString
+  (
+    stripBS
+  , UriEncodable(..)
+  ) where
+
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Builder as BB
+import qualified Data.ByteString.Char8 as BC8
+import qualified Data.ByteString.Lazy as LB
+import           Data.Char (isSpace, toUpper)
+import qualified Data.Text as T
+import           Numeric (showHex)
+
+import           Lib.Prelude
+
+stripBS :: ByteString -> ByteString
+stripBS = BC8.dropWhile isSpace . fst . BC8.spanEnd isSpace
+
+class UriEncodable s where
+  uriEncode :: Bool -> s -> ByteString
+
+instance UriEncodable [Char] where
+  uriEncode encodeSlash payload =
+    LB.toStrict $ BB.toLazyByteString $ mconcat $
+    map (flip uriEncodeChar encodeSlash) payload
+
+instance UriEncodable ByteString where
+  -- assumes that uriEncode is passed ASCII encoded strings.
+  uriEncode encodeSlash bs =
+    uriEncode encodeSlash $ BC8.unpack bs
+
+instance UriEncodable Text where
+  uriEncode encodeSlash txt =
+    uriEncode encodeSlash $ T.unpack txt
+
+-- | URI encode a char according to AWS S3 signing rules - see
+-- UriEncode() at
+-- https://docs.aws.amazon.com/AmazonS3/latest/API/sig-v4-header-based-auth.html
+uriEncodeChar :: Char -> Bool -> BB.Builder
+uriEncodeChar '/' True = BB.byteString "%2F"
+uriEncodeChar '/' False = BB.char7 '/'
+uriEncodeChar ch _
+  | (ch >= 'A' && ch <= 'Z')
+    || (ch >= 'a' && ch <= 'z')
+    || (ch >= '0' && ch <= '9')
+    || (ch == '_')
+    || (ch == '-')
+    || (ch == '.')
+    || (ch == '~') = BB.char7 ch
+  | otherwise = mconcat $ map f $ B.unpack $ encodeUtf8 $ T.singleton ch
+  where
+    f :: Word8 -> BB.Builder
+    f n = BB.char7 '%' <> BB.string7 hexStr
+      where
+        hexStr = map toUpper $ showHex q $ showHex r ""
+        (q, r) = divMod (fromIntegral n) (16::Word8)

src/Network/Minio/Data/Crypto.hs

@@ -0,0 +1,17 @@
+module Network.Minio.Data.Crypto
+  (
+    hashSHA256
+  , hmacSHA256
+  ) where
+
+import Crypto.Hash (SHA256(..), hashWith, Digest)
+import Crypto.MAC.HMAC (hmac, HMAC(hmacGetDigest))
+
+import Lib.Prelude
+
+hashSHA256 :: ByteString -> ByteString
+hashSHA256 = show . hashWith SHA256
+
+hmacSHA256 :: ByteString -> ByteString -> ByteString
+hmacSHA256 message key =
+  show (hmacGetDigest (hmac key message) :: Digest SHA256)

src/Network/Minio/Data/Time.hs

@@ -0,0 +1,25 @@
+module Network.Minio.Data.Time
+  (
+    awsTimeFormat
+  , awsTimeFormatBS
+  , awsDateFormat
+  , awsDateFormatBS
+  ) where
+
+
+import           Data.ByteString.Char8 (pack)
+import qualified Data.Time as Time
+
+import           Lib.Prelude
+
+awsTimeFormat :: UTCTime -> [Char]
+awsTimeFormat = Time.formatTime Time.defaultTimeLocale "%Y%m%dT%H%M%SZ"
+
+awsTimeFormatBS :: UTCTime -> ByteString
+awsTimeFormatBS = pack . awsTimeFormat
+
+awsDateFormat :: UTCTime -> [Char]
+awsDateFormat = Time.formatTime Time.defaultTimeLocale "%Y%m%d"
+
+awsDateFormatBS :: UTCTime -> ByteString
+awsDateFormatBS = pack . awsDateFormat

src/Network/Minio/Sign/V4.hs

@@ -0,0 +1,122 @@
+module Network.Minio.Sign.V4
+  (
+    signV4
+  ) where
+
+import qualified Data.ByteString as B
+import           Data.ByteString.Char8 (pack)
+import           Data.CaseInsensitive (mk)
+import qualified Data.CaseInsensitive as CI
+import qualified Data.Set as Set
+import qualified Data.Time as Time
+import           Network.HTTP.Types (Header)
+
+import           Lib.Prelude
+import           Network.Minio.Data
+import           Network.Minio.Data.ByteString
+import           Network.Minio.Data.Crypto
+import           Network.Minio.Data.Time
+
+ignoredHeaders :: Set ByteString
+ignoredHeaders = Set.fromList $ map CI.foldedCase [
+  mk "Authorization",
+  mk "Content-Type",
+  mk "Content-Length",
+  mk "User-Agent"
+  ]
+
+-- | 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
+-- Authorization header, which includes the signature.
+signV4 :: MinioClient -> RequestInfo
+       -> IO [Header]
+signV4 mc ri = do
+  timestamp <- Time.getCurrentTime
+  return $ signV4AtTime timestamp mc ri
+
+-- | 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
+  where
+    timeBS = awsTimeFormatBS ts
+    dateHeader = (mk "X-Amz-Date", timeBS)
+
+    headersWithDate = dateHeader : (headers ri)
+
+    authHeader = (mk "Authorization", authHeaderValue)
+
+    scope = getScope ts mc
+
+    authHeaderValue = B.concat [
+      "AWS4-HMAC-SHA256 Credential=",
+      scope,
+      ", SignedHeaders=", signedHeaders,
+      ", Signature=", signature
+      ]
+
+    headersToSign = getHeadersToSign headersWithDate
+
+    signedHeaders = B.intercalate ";" $ map fst headersToSign
+
+    signature = hmacSHA256 stringToSign signingKey
+
+    signingKey = hmacSHA256 "aws4_request"
+               . hmacSHA256 "s3"
+               . hmacSHA256 (encodeUtf8 $ mcRegion mc)
+               . hmacSHA256 timeBS
+               $ (B.concat ["AWS4", encodeUtf8 $ mcSecretKey mc])
+
+    stringToSign  = B.intercalate "\n" $
+      ["AWS4-HMAC-SHA256",
+       timeBS,
+       scope,
+       hashSHA256 $ canonicalRequest
+      ]
+
+    canonicalRequest = getCanonicalRequest ri headersToSign
+
+
+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"
+  ]
+
+getHeadersToSign :: [Header] -> [(ByteString, ByteString)]
+getHeadersToSign h =
+  sort $
+  filter (flip Set.notMember ignoredHeaders . fst) $
+  map (\(x, y) -> (CI.foldedCase x, stripBS y)) $
+  h
+
+getCanonicalRequest :: RequestInfo -> [(ByteString, ByteString)] -> ByteString
+getCanonicalRequest ri headersForSign = B.intercalate "\n" $ [
+  method ri,
+  uriEncode False path,
+  canonicalQueryString,
+  canonicalHeaders,
+  signedHeaders,
+  payloadHash ri,
+  ""
+  ]
+  where
+    path = B.concat $
+      maybe [] (\bkt -> bkt : (
+                   maybe [] (\obj ->
+                                ["/", encodeUtf8 $ obj]) $ object ri)) $
+      bucket ri
+
+    canonicalQueryString = B.intercalate "&" $
+      map (\(x, y) -> B.concat [x, "=", y]) $
+      sort $ map (\(x, y) ->
+                    (uriEncode True x, maybe "" (uriEncode True) y)) $
+      queryParams ri
+
+    canonicalHeaders = B.concat $
+      map (\(x, y) -> B.concat [x, ":", y, "\n"]) $
+      headersForSign
+
+    signedHeaders = B.intercalate ";" $ map fst headersForSign