diff --git a/app/Main.hs b/app/Main.hs index 0fc6909..48b3b3a 100644 --- a/app/Main.hs +++ b/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 [] [] "" "" diff --git a/minio-client.cabal b/minio-hs.cabal similarity index 61% rename from minio-client.cabal rename to minio-hs.cabal index 6e252d8..8324776 100644 --- a/minio-client.cabal +++ b/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 diff --git a/src/Lib.hs b/src/Lib.hs deleted file mode 100644 index 31dee08..0000000 --- a/src/Lib.hs +++ /dev/null @@ -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: - --} -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 = \ No newline at end of file diff --git a/src/Lib/Prelude.hs b/src/Lib/Prelude.hs index 3524456..24ba3c0 100644 --- a/src/Lib/Prelude.hs +++ b/src/Lib/Prelude.hs @@ -9,3 +9,5 @@ module Lib.Prelude ) where import Protolude as Exports + +import Data.Time as Exports (UTCTime) diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs new file mode 100644 index 0000000..af5fe32 --- /dev/null +++ b/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) + } diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs new file mode 100644 index 0000000..7fce081 --- /dev/null +++ b/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 diff --git a/src/Network/Minio/Data/ByteString.hs b/src/Network/Minio/Data/ByteString.hs new file mode 100644 index 0000000..ff64b70 --- /dev/null +++ b/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) diff --git a/src/Network/Minio/Data/Crypto.hs b/src/Network/Minio/Data/Crypto.hs new file mode 100644 index 0000000..b429df3 --- /dev/null +++ b/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) diff --git a/src/Network/Minio/Data/Time.hs b/src/Network/Minio/Data/Time.hs new file mode 100644 index 0000000..35d8dba --- /dev/null +++ b/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 diff --git a/src/Network/Minio/Sign/V4.hs b/src/Network/Minio/Sign/V4.hs new file mode 100644 index 0000000..cc7da75 --- /dev/null +++ b/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