fix: build

This commit is contained in:
Gregor Kleen 2020-07-03 10:37:09 +02:00
parent 1beeab1e68
commit c79a03a3af
6 changed files with 24 additions and 17 deletions

View File

@ -44,13 +44,14 @@ import UnliftIO as Exports
throwIO, throwIO,
try, try,
) )
import qualified Data.Text.Encoding as T
-- | Apply a function on both elements of a pair -- | Apply a function on both elements of a pair
both :: (a -> b) -> (a, a) -> (b, b) both :: (a -> b) -> (a, a) -> (b, b)
both f (a, b) = (f a, f b) both f (a, b) = (f a, f b)
showBS :: Show a => a -> ByteString showBS :: Show a => a -> ByteString
showBS a = toUtf8 (show a :: Text) showBS a = T.encodeUtf8 (show a :: Text)
toStrictBS :: LByteString -> ByteString toStrictBS :: LByteString -> ByteString
toStrictBS = LB.toStrict toStrictBS = LB.toStrict

View File

@ -221,9 +221,9 @@ disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}
getHostAddr :: ConnectInfo -> ByteString getHostAddr :: ConnectInfo -> ByteString
getHostAddr ci = getHostAddr ci =
if if
| port == 80 || port == 443 -> toUtf8 host | port == 80 || port == 443 -> TE.encodeUtf8 host
| otherwise -> | otherwise ->
toUtf8 $ TE.encodeUtf8 $
T.concat [host, ":", Lib.Prelude.show port] T.concat [host, ":", Lib.Prelude.show port]
where where
port = connectPort ci port = connectPort ci
@ -1034,7 +1034,7 @@ defaultS3ReqInfo =
getS3Path :: Maybe Bucket -> Maybe Object -> ByteString getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
getS3Path b o = getS3Path b o =
let segments = map toUtf8 $ catMaybes $ b : bool [] [o] (isJust b) let segments = map TE.encodeUtf8 $ catMaybes $ b : bool [] [o] (isJust b)
in B.concat ["/", B.intercalate "/" segments] in B.concat ["/", B.intercalate "/" segments]
-- | Time to expire for a presigned URL. It interpreted as a number of -- | Time to expire for a presigned URL. It interpreted as a number of
@ -1054,10 +1054,12 @@ newtype Minio a = Minio
Monad, Monad,
MonadIO, MonadIO,
MonadReader MinioConn, MonadReader MinioConn,
MonadResource, MonadResource
MonadUnliftIO
) )
instance MonadUnliftIO Minio where
askUnliftIO = (\(U.UnliftIO unliftIO) -> U.UnliftIO $ \(Minio f) -> unliftIO f) <$> Minio U.askUnliftIO
-- | MinioConn holds connection info and a connection pool to allow -- | MinioConn holds connection info and a connection pool to allow
-- for efficient resource re-use. -- for efficient resource re-use.
data MinioConn = MinioConn data MinioConn = MinioConn

View File

@ -25,7 +25,7 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Char8 as BC8
import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString.Lazy as LB
import Data.Char (isAsciiLower, isAsciiUpper) import Data.Char (isAsciiLower, isAsciiUpper, isSpace, isDigit, toUpper)
import qualified Data.Text as T import qualified Data.Text as T
import Lib.Prelude import Lib.Prelude
import Numeric (showHex) import Numeric (showHex)

View File

@ -40,6 +40,7 @@ import qualified Data.Aeson as Json
import Data.ByteString.Builder (byteString, toLazyByteString) import Data.ByteString.Builder (byteString, toLazyByteString)
import qualified Data.HashMap.Strict as H import qualified Data.HashMap.Strict as H
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Time as Time import qualified Data.Time as Time
import Lib.Prelude import Lib.Prelude
import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Conduit as NC
@ -331,7 +332,7 @@ presignedPostPolicy p = do
mkPair (PPCEquals k v) = Just (k, v) mkPair (PPCEquals k v) = Just (k, v)
mkPair _ = Nothing mkPair _ = Nothing
formFromPolicy = formFromPolicy =
H.map toUtf8 $ H.fromList $ catMaybes $ H.map TE.encodeUtf8 $ H.fromList $ catMaybes $
mkPair <$> conditions ppWithCreds mkPair <$> conditions ppWithCreds
formData = formFromPolicy `H.union` signData formData = formFromPolicy `H.union` signData
-- compute POST upload URL -- compute POST upload URL

View File

@ -93,6 +93,7 @@ where
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Lib.Prelude import Lib.Prelude
import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Conduit as NC
import qualified Network.HTTP.Types as HT import qualified Network.HTTP.Types as HT
@ -370,7 +371,7 @@ putObjectPart bucket object uploadId partNumber headers payload = do
srcInfoToHeaders :: SourceInfo -> [HT.Header] srcInfoToHeaders :: SourceInfo -> [HT.Header]
srcInfoToHeaders srcInfo = srcInfoToHeaders srcInfo =
( "x-amz-copy-source", ( "x-amz-copy-source",
toUtf8 $ TE.encodeUtf8 $
T.concat T.concat
[ "/", [ "/",
srcBucket srcInfo, srcBucket srcInfo,

View File

@ -36,6 +36,8 @@ import Network.Minio.Data.Crypto
import Network.Minio.Data.Time import Network.Minio.Data.Time
import Network.Minio.Errors import Network.Minio.Errors
import Text.Printf (printf) import Text.Printf (printf)
import qualified Data.Text.Encoding as TE
import qualified Data.Text as T
-- these headers are not included in the string to sign when signing a -- these headers are not included in the string to sign when signing a
-- request -- request
@ -92,7 +94,7 @@ mkAuthHeader accessKey scope signedHeaderKeys sign =
let authValue = let authValue =
B.concat B.concat
[ "AWS4-HMAC-SHA256 Credential=", [ "AWS4-HMAC-SHA256 Credential=",
toUtf8 accessKey, TE.encodeUtf8 accessKey,
"/", "/",
scope, scope,
", SignedHeaders=", ", SignedHeaders=",
@ -119,8 +121,8 @@ signV4 !sp !req =
let region = fromMaybe "" $ spRegion sp let region = fromMaybe "" $ spRegion sp
ts = spTimeStamp sp ts = spTimeStamp sp
scope = mkScope ts region scope = mkScope ts region
accessKey = toUtf8 $ spAccessKey sp accessKey = TE.encodeUtf8 $ spAccessKey sp
secretKey = toUtf8 $ spSecretKey sp secretKey = TE.encodeUtf8 $ spSecretKey sp
expiry = spExpirySecs sp expiry = spExpirySecs sp
sha256Hdr = sha256Hdr =
( "x-amz-content-sha256", ( "x-amz-content-sha256",
@ -179,8 +181,8 @@ mkScope :: UTCTime -> Text -> ByteString
mkScope ts region = mkScope ts region =
B.intercalate B.intercalate
"/" "/"
[ toUtf8 $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts, [ TE.encodeUtf8 . T.pack $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts,
toUtf8 region, TE.encodeUtf8 region,
"s3", "s3",
"aws4_request" "aws4_request"
] ]
@ -239,7 +241,7 @@ mkSigningKey :: UTCTime -> Text -> ByteString -> ByteString
mkSigningKey ts region !secretKey = mkSigningKey ts region !secretKey =
hmacSHA256RawBS "aws4_request" hmacSHA256RawBS "aws4_request"
. hmacSHA256RawBS "s3" . hmacSHA256RawBS "s3"
. hmacSHA256RawBS (toUtf8 region) . hmacSHA256RawBS (TE.encodeUtf8 region)
. hmacSHA256RawBS (awsDateFormatBS ts) . hmacSHA256RawBS (awsDateFormatBS ts)
$ B.concat ["AWS4", secretKey] $ B.concat ["AWS4", secretKey]
@ -256,7 +258,7 @@ signV4PostPolicy ::
signV4PostPolicy !postPolicyJSON !sp = signV4PostPolicy !postPolicyJSON !sp =
let stringToSign = Base64.encode postPolicyJSON let stringToSign = Base64.encode postPolicyJSON
region = fromMaybe "" $ spRegion sp region = fromMaybe "" $ spRegion sp
signingKey = mkSigningKey (spTimeStamp sp) region $ toUtf8 $ spSecretKey sp signingKey = mkSigningKey (spTimeStamp sp) region $ TE.encodeUtf8 $ spSecretKey sp
signature = computeSignature stringToSign signingKey signature = computeSignature stringToSign signingKey
in Map.fromList in Map.fromList
[ ("x-amz-signature", signature), [ ("x-amz-signature", signature),
@ -332,7 +334,7 @@ signV4Stream !payloadLength !sp !req =
stringToSign = mkStringToSign ts scope canonicalReq stringToSign = mkStringToSign ts scope canonicalReq
-- 1.3 Compute signature -- 1.3 Compute signature
-- 1.3.1 compute signing key -- 1.3.1 compute signing key
signingKey = mkSigningKey ts region $ toUtf8 secretKey signingKey = mkSigningKey ts region $ TE.encodeUtf8 secretKey
-- 1.3.2 Compute signature -- 1.3.2 Compute signature
seedSignature = computeSignature stringToSign signingKey seedSignature = computeSignature stringToSign signingKey
-- 1.3.3 Compute Auth Header -- 1.3.3 Compute Auth Header