module Network.Minio.Credentials.AssumeRole where
import qualified Data.ByteArray as BA
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as T
import qualified Data.Time as Time
import Data.Time.Units (Second)
import Lib.Prelude (UTCTime, throwIO)
import Network.HTTP.Client (RequestBody (RequestBodyBS))
import qualified Network.HTTP.Client as NC
import Network.HTTP.Types (hContentType, methodPost, renderSimpleQuery)
import Network.HTTP.Types.Header (hHost)
import Network.Minio.Credentials.Types
import Network.Minio.Data.Crypto (hashSHA256)
import Network.Minio.Errors (MErrV (..))
import Network.Minio.Sign.V4
import Network.Minio.Utils (getHostHeader, httpLbs)
import Network.Minio.XmlCommon
import Text.XML.Cursor hiding (bool)
stsVersion :: ByteString
stsVersion :: ByteString
stsVersion = ByteString
"2011-06-15"
defaultDurationSeconds :: Second
defaultDurationSeconds :: Second
defaultDurationSeconds = Second
3600
data STSAssumeRole = STSAssumeRole
{
STSAssumeRole -> CredentialValue
sarCredentials :: CredentialValue,
STSAssumeRole -> STSAssumeRoleOptions
sarOptions :: STSAssumeRoleOptions
}
data STSAssumeRoleOptions = STSAssumeRoleOptions
{
STSAssumeRoleOptions -> Maybe Text
saroEndpoint :: Maybe Text,
STSAssumeRoleOptions -> Maybe Second
saroDurationSeconds :: Maybe Second,
STSAssumeRoleOptions -> Maybe ByteString
saroPolicyJSON :: Maybe ByteString,
STSAssumeRoleOptions -> Maybe Text
saroLocation :: Maybe Text,
STSAssumeRoleOptions -> Maybe Text
saroRoleARN :: Maybe Text,
STSAssumeRoleOptions -> Maybe Text
saroRoleSessionName :: Maybe Text
}
defaultSTSAssumeRoleOptions :: STSAssumeRoleOptions
defaultSTSAssumeRoleOptions :: STSAssumeRoleOptions
defaultSTSAssumeRoleOptions =
STSAssumeRoleOptions
{ saroEndpoint :: Maybe Text
saroEndpoint = forall a. Maybe a
Nothing,
saroDurationSeconds :: Maybe Second
saroDurationSeconds = forall a. a -> Maybe a
Just Second
3600,
saroPolicyJSON :: Maybe ByteString
saroPolicyJSON = forall a. Maybe a
Nothing,
saroLocation :: Maybe Text
saroLocation = forall a. Maybe a
Nothing,
saroRoleARN :: Maybe Text
saroRoleARN = forall a. Maybe a
Nothing,
saroRoleSessionName :: Maybe Text
saroRoleSessionName = forall a. Maybe a
Nothing
}
data AssumeRoleCredentials = AssumeRoleCredentials
{ AssumeRoleCredentials -> CredentialValue
arcCredentials :: CredentialValue,
AssumeRoleCredentials -> UTCTime
arcExpiration :: UTCTime
}
deriving stock (Int -> AssumeRoleCredentials -> ShowS
[AssumeRoleCredentials] -> ShowS
AssumeRoleCredentials -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssumeRoleCredentials] -> ShowS
$cshowList :: [AssumeRoleCredentials] -> ShowS
show :: AssumeRoleCredentials -> String
$cshow :: AssumeRoleCredentials -> String
showsPrec :: Int -> AssumeRoleCredentials -> ShowS
$cshowsPrec :: Int -> AssumeRoleCredentials -> ShowS
Show, AssumeRoleCredentials -> AssumeRoleCredentials -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssumeRoleCredentials -> AssumeRoleCredentials -> Bool
$c/= :: AssumeRoleCredentials -> AssumeRoleCredentials -> Bool
== :: AssumeRoleCredentials -> AssumeRoleCredentials -> Bool
$c== :: AssumeRoleCredentials -> AssumeRoleCredentials -> Bool
Eq)
data AssumeRoleResult = AssumeRoleResult
{ AssumeRoleResult -> Text
arrSourceIdentity :: Text,
AssumeRoleResult -> Text
arrAssumedRoleArn :: Text,
AssumeRoleResult -> Text
arrAssumedRoleId :: Text,
AssumeRoleResult -> AssumeRoleCredentials
arrRoleCredentials :: AssumeRoleCredentials
}
deriving stock (Int -> AssumeRoleResult -> ShowS
[AssumeRoleResult] -> ShowS
AssumeRoleResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssumeRoleResult] -> ShowS
$cshowList :: [AssumeRoleResult] -> ShowS
show :: AssumeRoleResult -> String
$cshow :: AssumeRoleResult -> String
showsPrec :: Int -> AssumeRoleResult -> ShowS
$cshowsPrec :: Int -> AssumeRoleResult -> ShowS
Show, AssumeRoleResult -> AssumeRoleResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssumeRoleResult -> AssumeRoleResult -> Bool
$c/= :: AssumeRoleResult -> AssumeRoleResult -> Bool
== :: AssumeRoleResult -> AssumeRoleResult -> Bool
$c== :: AssumeRoleResult -> AssumeRoleResult -> Bool
Eq)
parseSTSAssumeRoleResult :: (MonadIO m) => ByteString -> Text -> m AssumeRoleResult
parseSTSAssumeRoleResult :: forall (m :: * -> *).
MonadIO m =>
ByteString -> Text -> m AssumeRoleResult
parseSTSAssumeRoleResult ByteString
xmldata Text
namespace = do
Cursor
r <- forall (m :: * -> *). MonadIO m => LByteString -> m Cursor
parseRoot forall a b. (a -> b) -> a -> b
$ ByteString -> LByteString
LB.fromStrict ByteString
xmldata
let s3Elem' :: Text -> Axis
s3Elem' = Text -> Text -> Axis
s3Elem Text
namespace
sourceIdentity :: Text
sourceIdentity =
[Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$
Cursor
r
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
s3Elem' Text
"AssumeRoleResult"
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Axis
s3Elem' Text
"SourceIdentity"
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
roleArn :: Text
roleArn =
[Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$
Cursor
r
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
s3Elem' Text
"AssumeRoleResult"
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Axis
s3Elem' Text
"AssumedRoleUser"
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Axis
s3Elem' Text
"Arn"
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
roleId :: Text
roleId =
[Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$
Cursor
r
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
s3Elem' Text
"AssumeRoleResult"
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Axis
s3Elem' Text
"AssumedRoleUser"
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Axis
s3Elem' Text
"AssumedRoleId"
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
convSB :: Text -> BA.ScrubbedBytes
convSB :: Text -> ScrubbedBytes
convSB = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 :: Text -> ByteString)
credsInfo :: Either MErrV (CredentialValue, Text)
credsInfo = do
Cursor
cr <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> MErrV
MErrVXmlParse Text
"No Credentials Element found") forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$
Cursor
r forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
s3Elem' Text
"AssumeRoleResult" forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Axis
s3Elem' Text
"Credentials"
let cur :: Cursor
cur = Node -> Cursor
fromNode forall a b. (a -> b) -> a -> b
$ forall node. Cursor node -> node
node Cursor
cr
forall (m :: * -> *) a. Monad m => a -> m a
return
( CredentialValue
{ cvAccessKey :: AccessKey
cvAccessKey =
coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$
Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
s3Elem' Text
"AccessKeyId" forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content,
cvSecretKey :: SecretKey
cvSecretKey =
coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$
Text -> ScrubbedBytes
convSB forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$
Cursor
cur
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
s3Elem' Text
"SecretAccessKey"
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content,
cvSessionToken :: Maybe SessionToken
cvSessionToken =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$
Text -> ScrubbedBytes
convSB forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$
Cursor
cur
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
s3Elem' Text
"SessionToken"
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
},
[Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
s3Elem' Text
"Expiration" forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
)
(CredentialValue, Text)
creds <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure Either MErrV (CredentialValue, Text)
credsInfo
UTCTime
expiry <- forall (m :: * -> *). MonadIO m => Text -> m UTCTime
parseS3XMLTime forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (CredentialValue, Text)
creds
let roleCredentials :: AssumeRoleCredentials
roleCredentials =
AssumeRoleCredentials
{ arcCredentials :: CredentialValue
arcCredentials = forall a b. (a, b) -> a
fst (CredentialValue, Text)
creds,
arcExpiration :: UTCTime
arcExpiration = UTCTime
expiry
}
forall (m :: * -> *) a. Monad m => a -> m a
return
AssumeRoleResult
{ arrSourceIdentity :: Text
arrSourceIdentity = Text
sourceIdentity,
arrAssumedRoleArn :: Text
arrAssumedRoleArn = Text
roleArn,
arrAssumedRoleId :: Text
arrAssumedRoleId = Text
roleId,
arrRoleCredentials :: AssumeRoleCredentials
arrRoleCredentials = AssumeRoleCredentials
roleCredentials
}
instance STSCredentialProvider STSAssumeRole where
getSTSEndpoint :: STSAssumeRole -> Maybe Text
getSTSEndpoint = STSAssumeRoleOptions -> Maybe Text
saroEndpoint forall b c a. (b -> c) -> (a -> b) -> a -> c
. STSAssumeRole -> STSAssumeRoleOptions
sarOptions
retrieveSTSCredentials :: STSAssumeRole
-> Endpoint -> Manager -> IO (CredentialValue, ExpiryTime)
retrieveSTSCredentials STSAssumeRole
sar (ByteString
host', Int
port', Bool
isSecure') Manager
mgr = do
let requiredParams :: [(ByteString, ByteString)]
requiredParams =
[ (ByteString
"Action", ByteString
"AssumeRole"),
(ByteString
"Version", ByteString
stsVersion)
]
opts :: STSAssumeRoleOptions
opts = STSAssumeRole -> STSAssumeRoleOptions
sarOptions STSAssumeRole
sar
Int
durSecs :: Int =
forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a -> a
fromMaybe Second
defaultDurationSeconds forall a b. (a -> b) -> a -> b
$
STSAssumeRoleOptions -> Maybe Second
saroDurationSeconds STSAssumeRoleOptions
opts
otherParams :: [Maybe (ByteString, ByteString)]
otherParams =
[ (ByteString
"RoleArn",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STSAssumeRoleOptions -> Maybe Text
saroRoleARN STSAssumeRoleOptions
opts,
(ByteString
"RoleSessionName",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STSAssumeRoleOptions -> Maybe Text
saroRoleSessionName STSAssumeRoleOptions
opts,
forall a. a -> Maybe a
Just (ByteString
"DurationSeconds", forall b a. (Show a, IsString b) => a -> b
show Int
durSecs),
(ByteString
"Policy",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STSAssumeRoleOptions -> Maybe ByteString
saroPolicyJSON STSAssumeRoleOptions
opts
]
parameters :: [(ByteString, ByteString)]
parameters = [(ByteString, ByteString)]
requiredParams forall a. [a] -> [a] -> [a]
++ forall a. [Maybe a] -> [a]
catMaybes [Maybe (ByteString, ByteString)]
otherParams
(ByteString
host, Int
port, Bool
isSecure) =
case forall p. STSCredentialProvider p => p -> Maybe Text
getSTSEndpoint STSAssumeRole
sar of
Just Text
ep ->
let endPt :: Request
endPt = String -> Request
NC.parseRequest_ forall a b. (a -> b) -> a -> b
$ forall a. ToString a => a -> String
toString Text
ep
in (Request -> ByteString
NC.host Request
endPt, Request -> Int
NC.port Request
endPt, Request -> Bool
NC.secure Request
endPt)
Maybe Text
Nothing -> (ByteString
host', Int
port', Bool
isSecure')
reqBody :: ByteString
reqBody = Bool -> [(ByteString, ByteString)] -> ByteString
renderSimpleQuery Bool
False [(ByteString, ByteString)]
parameters
req :: Request
req =
Request
NC.defaultRequest
{ host :: ByteString
NC.host = ByteString
host,
port :: Int
NC.port = Int
port,
secure :: Bool
NC.secure = Bool
isSecure,
method :: ByteString
NC.method = ByteString
methodPost,
requestHeaders :: RequestHeaders
NC.requestHeaders =
[ (HeaderName
hHost, (ByteString, Int) -> ByteString
getHostHeader (ByteString
host, Int
port)),
(HeaderName
hContentType, ByteString
"application/x-www-form-urlencoded")
],
requestBody :: RequestBody
NC.requestBody = ByteString -> RequestBody
RequestBodyBS ByteString
reqBody
}
UTCTime
timeStamp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
Time.getCurrentTime
let sp :: SignParams
sp =
SignParams
{ spAccessKey :: Text
spAccessKey = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ CredentialValue -> AccessKey
cvAccessKey forall a b. (a -> b) -> a -> b
$ STSAssumeRole -> CredentialValue
sarCredentials STSAssumeRole
sar,
spSecretKey :: ScrubbedBytes
spSecretKey = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ CredentialValue -> SecretKey
cvSecretKey forall a b. (a -> b) -> a -> b
$ STSAssumeRole -> CredentialValue
sarCredentials STSAssumeRole
sar,
spSessionToken :: Maybe ScrubbedBytes
spSessionToken = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ CredentialValue -> Maybe SessionToken
cvSessionToken forall a b. (a -> b) -> a -> b
$ STSAssumeRole -> CredentialValue
sarCredentials STSAssumeRole
sar,
spService :: Service
spService = Service
ServiceSTS,
spTimeStamp :: UTCTime
spTimeStamp = UTCTime
timeStamp,
spRegion :: Maybe Text
spRegion = STSAssumeRoleOptions -> Maybe Text
saroLocation STSAssumeRoleOptions
opts,
spExpirySecs :: Maybe Int
spExpirySecs = forall a. Maybe a
Nothing,
spPayloadHash :: Maybe ByteString
spPayloadHash = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
hashSHA256 ByteString
reqBody
}
signHeaders :: RequestHeaders
signHeaders = SignParams -> Request -> RequestHeaders
signV4 SignParams
sp Request
req
signedReq :: Request
signedReq =
Request
req
{ requestHeaders :: RequestHeaders
NC.requestHeaders = Request -> RequestHeaders
NC.requestHeaders Request
req forall a. [a] -> [a] -> [a]
++ RequestHeaders
signHeaders
}
Response LByteString
resp <- forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response LByteString)
httpLbs Request
signedReq Manager
mgr
AssumeRoleResult
result <-
forall (m :: * -> *).
MonadIO m =>
ByteString -> Text -> m AssumeRoleResult
parseSTSAssumeRoleResult
(forall l s. LazyStrict l s => l -> s
toStrict forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
NC.responseBody Response LByteString
resp)
Text
"https://sts.amazonaws.com/doc/2011-06-15/"
forall (m :: * -> *) a. Monad m => a -> m a
return
( AssumeRoleCredentials -> CredentialValue
arcCredentials forall a b. (a -> b) -> a -> b
$ AssumeRoleResult -> AssumeRoleCredentials
arrRoleCredentials AssumeRoleResult
result,
coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ AssumeRoleCredentials -> UTCTime
arcExpiration forall a b. (a -> b) -> a -> b
$ AssumeRoleResult -> AssumeRoleCredentials
arrRoleCredentials AssumeRoleResult
result
)