{-# LANGUAGE CPP #-}
module Aws.Core
(
Loggable(..)
, Response(..)
, readResponse
, readResponseIO
, tellMetadata
, tellMetadataRef
, mapMetadata
, HTTPResponseConsumer
, ResponseConsumer(..)
, AsMemoryResponse(..)
, ListResponse(..)
, XmlException(..)
, HeaderException(..)
, FormException(..)
, NoCredentialsException(..)
, throwStatusCodeException
, readHex2
, elContent
, elCont
, force
, forceM
, textReadBool
, textReadInt
, readInt
, xmlCursorConsumer
, SignedQuery(..)
, NormalQuery
, UriOnlyQuery
, queryToHttpRequest
, queryToUri
, TimeInfo(..)
, AbsoluteTimeInfo(..)
, fromAbsoluteTimeInfo
, makeAbsoluteTimeInfo
, SignatureData(..)
, signatureData
, SignQuery(..)
, AuthorizationHash(..)
, amzHash
, signature
, credentialV4
, authorizationV4
, authorizationV4'
, signatureV4
, queryList
, awsBool
, awsTrue
, awsFalse
, fmtTime
, fmtRfc822Time
, rfc822Time
, fmtAmzTime
, fmtTimeEpochSeconds
, parseHttpDate
, httpDate1
, textHttpDate
, iso8601UtcDate
, Transaction
, IteratedTransaction(..)
, Credentials(..)
, makeCredentials
, credentialsDefaultFile
, credentialsDefaultKey
, loadCredentialsFromFile
, loadCredentialsFromEnv
, loadCredentialsFromInstanceMetadata
, loadCredentialsFromEnvOrFile
, loadCredentialsFromEnvOrFileOrInstanceMetadata
, loadCredentialsDefault
, anonymousCredentials
, DefaultServiceConfiguration(..)
, Protocol(..)
, defaultPort
, Method(..)
, httpMethod
)
where
import Aws.Ec2.InstanceMetadata
import Aws.Network
import qualified Blaze.ByteString.Builder as Blaze
import Control.Applicative
import Control.Arrow
import qualified Control.Exception as E
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource (ResourceT, MonadThrow (throwM))
import qualified Crypto.Hash as CH
import qualified Crypto.MAC.HMAC as CMH
import qualified Data.Aeson as A
import qualified Data.ByteArray as ByteArray
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Base64 as Base64
import Data.ByteString.Char8 ()
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.UTF8 as BU
import Data.Char
import Data.Conduit ((.|))
import qualified Data.Conduit as C
#if MIN_VERSION_http_conduit(2,2,0)
import qualified Data.Conduit.Binary as CB
#endif
import qualified Data.Conduit.List as CL
import Data.IORef
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import Data.Time
import qualified Data.Traversable as Traversable
import Data.Typeable
import Data.Word
import qualified Network.HTTP.Conduit as HTTP
import qualified Network.HTTP.Client.TLS as HTTP
import qualified Network.HTTP.Types as HTTP
import System.Directory
import System.Environment
import System.FilePath ((</>))
#if !MIN_VERSION_time(1,5,0)
import System.Locale
#endif
import qualified Text.XML as XML
import qualified Text.XML.Cursor as Cu
import Text.XML.Cursor hiding (force, forceM)
import Prelude
class Loggable a where
toLogText :: a -> T.Text
data Response m a = Response { forall m a. Response m a -> m
responseMetadata :: m
, forall m a. Response m a -> Either SomeException a
responseResult :: Either E.SomeException a }
deriving (Int -> Response m a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall m a. (Show m, Show a) => Int -> Response m a -> ShowS
forall m a. (Show m, Show a) => [Response m a] -> ShowS
forall m a. (Show m, Show a) => Response m a -> String
showList :: [Response m a] -> ShowS
$cshowList :: forall m a. (Show m, Show a) => [Response m a] -> ShowS
show :: Response m a -> String
$cshow :: forall m a. (Show m, Show a) => Response m a -> String
showsPrec :: Int -> Response m a -> ShowS
$cshowsPrec :: forall m a. (Show m, Show a) => Int -> Response m a -> ShowS
Show, forall a b. a -> Response m b -> Response m a
forall a b. (a -> b) -> Response m a -> Response m b
forall m a b. a -> Response m b -> Response m a
forall m a b. (a -> b) -> Response m a -> Response m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Response m b -> Response m a
$c<$ :: forall m a b. a -> Response m b -> Response m a
fmap :: forall a b. (a -> b) -> Response m a -> Response m b
$cfmap :: forall m a b. (a -> b) -> Response m a -> Response m b
Functor)
readResponse :: MonadThrow n => Response m a -> n a
readResponse :: forall (n :: * -> *) m a. MonadThrow n => Response m a -> n a
readResponse = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m a. Response m a -> Either SomeException a
responseResult
readResponseIO :: MonadIO io => Response m a -> io a
readResponseIO :: forall (io :: * -> *) m a. MonadIO io => Response m a -> io a
readResponseIO = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: * -> *) m a. MonadThrow n => Response m a -> n a
readResponse
tellMetadata :: m -> Response m ()
tellMetadata :: forall m. m -> Response m ()
tellMetadata m
m = forall m a. m -> Either SomeException a -> Response m a
Response m
m (forall (m :: * -> *) a. Monad m => a -> m a
return ())
mapMetadata :: (m -> n) -> Response m a -> Response n a
mapMetadata :: forall m n a. (m -> n) -> Response m a -> Response n a
mapMetadata m -> n
f (Response m
m Either SomeException a
a) = forall m a. m -> Either SomeException a -> Response m a
Response (m -> n
f m
m) Either SomeException a
a
instance Monoid m => Applicative (Response m) where
pure :: forall a. a -> Response m a
pure a
x = forall m a. m -> Either SomeException a -> Response m a
Response forall a. Monoid a => a
mempty (forall a b. b -> Either a b
Right a
x)
<*> :: forall a b. Response m (a -> b) -> Response m a -> Response m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monoid m => Monad (Response m) where
return :: forall a. a -> Response m a
return a
x = forall m a. m -> Either SomeException a -> Response m a
Response forall a. Monoid a => a
mempty (forall a b. b -> Either a b
Right a
x)
Response m
m1 (Left SomeException
e) >>= :: forall a b. Response m a -> (a -> Response m b) -> Response m b
>>= a -> Response m b
_ = forall m a. m -> Either SomeException a -> Response m a
Response m
m1 (forall a b. a -> Either a b
Left SomeException
e)
Response m
m1 (Right a
x) >>= a -> Response m b
f = let Response m
m2 Either SomeException b
y = a -> Response m b
f a
x
in forall m a. m -> Either SomeException a -> Response m a
Response (m
m1 forall a. Monoid a => a -> a -> a
`mappend` m
m2) Either SomeException b
y
instance Monoid m => MonadThrow (Response m) where
throwM :: forall e a. Exception e => e -> Response m a
throwM e
e = forall m a. m -> Either SomeException a -> Response m a
Response forall a. Monoid a => a
mempty (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e)
tellMetadataRef :: Monoid m => IORef m -> m -> IO ()
tellMetadataRef :: forall m. Monoid m => IORef m -> m -> IO ()
tellMetadataRef IORef m
r m
m = forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef m
r (forall a. Monoid a => a -> a -> a
`mappend` m
m)
type HTTPResponseConsumer a = HTTP.Response (C.ConduitM () ByteString (ResourceT IO) ())
-> ResourceT IO a
class Monoid (ResponseMetadata resp) => ResponseConsumer req resp where
type ResponseMetadata resp
responseConsumer :: HTTP.Request -> req -> IORef (ResponseMetadata resp) -> HTTPResponseConsumer resp
instance ResponseConsumer r (HTTP.Response L.ByteString) where
type ResponseMetadata (HTTP.Response L.ByteString) = ()
responseConsumer :: Request
-> r
-> IORef (ResponseMetadata (Response ByteString))
-> HTTPResponseConsumer (Response ByteString)
responseConsumer Request
_ r
_ IORef (ResponseMetadata (Response ByteString))
_ Response (ConduitM () ByteString (ResourceT IO) ())
resp = do
[ByteString]
bss <- forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
HTTP.responseBody Response (ConduitM () ByteString (ResourceT IO) ())
resp forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
forall (m :: * -> *) a. Monad m => a -> m a
return Response (ConduitM () ByteString (ResourceT IO) ())
resp
{ responseBody :: ByteString
HTTP.responseBody = [ByteString] -> ByteString
L.fromChunks [ByteString]
bss
}
class AsMemoryResponse resp where
type MemoryResponse resp :: *
loadToMemory :: resp -> ResourceT IO (MemoryResponse resp)
class ListResponse resp item | resp -> item where
listResponse :: resp -> [item]
class (SignQuery r, ResponseConsumer r a, Loggable (ResponseMetadata a))
=> Transaction r a
| r -> a
class Transaction r a => IteratedTransaction r a | r -> a where
nextIteratedRequest :: r -> a -> Maybe r
type V4Key = ((B.ByteString,B.ByteString),(B.ByteString,B.ByteString))
data Credentials
= Credentials {
Credentials -> ByteString
accessKeyID :: B.ByteString
, Credentials -> ByteString
secretAccessKey :: B.ByteString
, Credentials -> IORef [V4Key]
v4SigningKeys :: IORef [V4Key]
, Credentials -> Maybe ByteString
iamToken :: Maybe B.ByteString
, Credentials -> Bool
isAnonymousCredentials :: Bool
}
instance Show Credentials where
show :: Credentials -> String
show c :: Credentials
c@(Credentials {}) = String
"Credentials{accessKeyID=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Credentials -> ByteString
accessKeyID Credentials
c) forall a. [a] -> [a] -> [a]
++ String
",secretAccessKey=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Credentials -> ByteString
secretAccessKey Credentials
c) forall a. [a] -> [a] -> [a]
++ String
",iamToken=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Credentials -> Maybe ByteString
iamToken Credentials
c) forall a. [a] -> [a] -> [a]
++ String
"}"
makeCredentials :: MonadIO io
=> B.ByteString
-> B.ByteString
-> io Credentials
makeCredentials :: forall (io :: * -> *).
MonadIO io =>
ByteString -> ByteString -> io Credentials
makeCredentials ByteString
accessKeyID ByteString
secretAccessKey = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
IORef [V4Key]
v4SigningKeys <- forall a. a -> IO (IORef a)
newIORef []
let iamToken :: Maybe a
iamToken = forall a. Maybe a
Nothing
let isAnonymousCredentials :: Bool
isAnonymousCredentials = Bool
False
forall (m :: * -> *) a. Monad m => a -> m a
return Credentials { Bool
ByteString
IORef [V4Key]
forall a. Maybe a
isAnonymousCredentials :: Bool
iamToken :: forall a. Maybe a
v4SigningKeys :: IORef [V4Key]
secretAccessKey :: ByteString
accessKeyID :: ByteString
isAnonymousCredentials :: Bool
iamToken :: Maybe ByteString
v4SigningKeys :: IORef [V4Key]
secretAccessKey :: ByteString
accessKeyID :: ByteString
.. }
credentialsDefaultFile :: MonadIO io => io (Maybe FilePath)
credentialsDefaultFile :: forall (io :: * -> *). MonadIO io => io (Maybe String)
credentialsDefaultFile = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Maybe a)
tryMaybe ((String -> ShowS
</> String
".aws-keys") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getHomeDirectory)
tryMaybe :: IO a -> IO (Maybe a)
tryMaybe :: forall a. IO a -> IO (Maybe a)
tryMaybe IO a
action = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
action) forall a. SomeException -> IO (Maybe a)
f
where
f :: E.SomeException -> IO (Maybe a)
f :: forall a. SomeException -> IO (Maybe a)
f SomeException
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
credentialsDefaultKey :: T.Text
credentialsDefaultKey :: Text
credentialsDefaultKey = Text
"default"
loadCredentialsFromFile :: MonadIO io => FilePath -> T.Text -> io (Maybe Credentials)
loadCredentialsFromFile :: forall (io :: * -> *).
MonadIO io =>
String -> Text -> io (Maybe Credentials)
loadCredentialsFromFile String
file Text
key = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Bool
exists <- String -> IO Bool
doesFileExist String
file
if Bool
exists
then do
[[Text]]
contents <- forall a b. (a -> b) -> [a] -> [b]
map Text -> [Text]
T.words forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
file
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
Traversable.sequence forall a b. (a -> b) -> a -> b
$ do
[Text
_key, Text
keyID, Text
secret] <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall {a}. Eq a => a -> [a] -> Bool
hasKey Text
key) [[Text]]
contents
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (io :: * -> *).
MonadIO io =>
ByteString -> ByteString -> io Credentials
makeCredentials (Text -> ByteString
T.encodeUtf8 Text
keyID) (Text -> ByteString
T.encodeUtf8 Text
secret))
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
where
hasKey :: a -> [a] -> Bool
hasKey a
_ [] = Bool
False
hasKey a
k (a
k2 : [a]
_) = a
k forall a. Eq a => a -> a -> Bool
== a
k2
loadCredentialsFromEnv :: MonadIO io => io (Maybe Credentials)
loadCredentialsFromEnv :: forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
loadCredentialsFromEnv = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
[(String, String)]
env <- IO [(String, String)]
getEnvironment
let lk :: String -> Maybe ByteString
lk = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(String, String)]
env
keyID :: Maybe ByteString
keyID = String -> Maybe ByteString
lk String
"AWS_ACCESS_KEY_ID"
secret :: Maybe ByteString
secret = String -> Maybe ByteString
lk String
"AWS_ACCESS_KEY_SECRET" forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> Maybe ByteString
lk String
"AWS_SECRET_ACCESS_KEY"
setSession :: Credentials -> Credentials
setSession Credentials
creds = Credentials
creds { iamToken :: Maybe ByteString
iamToken = String -> Maybe ByteString
lk String
"AWS_SESSION_TOKEN" }
makeCredentials' :: ByteString -> ByteString -> IO Credentials
makeCredentials' ByteString
k ByteString
s = Credentials -> Credentials
setSession forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (io :: * -> *).
MonadIO io =>
ByteString -> ByteString -> io Credentials
makeCredentials ByteString
k ByteString
s
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
Traversable.sequence forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> IO Credentials
makeCredentials' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
keyID forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ByteString
secret
loadCredentialsFromInstanceMetadata :: MonadIO io => io (Maybe Credentials)
loadCredentialsFromInstanceMetadata :: forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
loadCredentialsFromInstanceMetadata = do
Manager
mgr <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Manager
HTTP.getGlobalManager
Bool
avail <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
hostAvailable String
"169.254.169.254"
if Bool -> Bool
not Bool
avail
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do
Maybe ByteString
info <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Manager -> String -> String -> IO ByteString
getInstanceMetadata Manager
mgr String
"latest/meta-data/iam" String
"info" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) (\(HttpException
_ :: HTTP.HttpException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
let infodict :: Maybe (Map String String)
infodict = Maybe ByteString
info forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FromJSON a => ByteString -> Maybe a
A.decode :: Maybe (M.Map String String)
info' :: Maybe String
info' = Maybe (Map String String)
infodict forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
"InstanceProfileArn"
case Maybe String
info' of
Just String
name ->
do
let name' :: String
name' = forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'/') forall a b. (a -> b) -> a -> b
$ String
name
Maybe ByteString
creds <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Manager -> String -> String -> IO ByteString
getInstanceMetadata Manager
mgr String
"latest/meta-data/iam/security-credentials" String
name' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) (\(HttpException
_ :: HTTP.HttpException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
let dict :: Maybe (Map String String)
dict = Maybe ByteString
creds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FromJSON a => ByteString -> Maybe a
A.decode :: Maybe (M.Map String String)
keyID :: Maybe String
keyID = Maybe (Map String String)
dict forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
"AccessKeyId"
secret :: Maybe String
secret = Maybe (Map String String)
dict forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
"SecretAccessKey"
token :: Maybe String
token = Maybe (Map String String)
dict forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
"Token"
IORef [V4Key]
ref <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef []
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
-> ByteString
-> IORef [V4Key]
-> Maybe ByteString
-> Bool
-> Credentials
Credentials forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
keyID)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
secret)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return IORef [V4Key]
ref
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
token)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
loadCredentialsFromEnvOrFile :: MonadIO io => FilePath -> T.Text -> io (Maybe Credentials)
loadCredentialsFromEnvOrFile :: forall (io :: * -> *).
MonadIO io =>
String -> Text -> io (Maybe Credentials)
loadCredentialsFromEnvOrFile String
file Text
key =
do
Maybe Credentials
envcr <- forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
loadCredentialsFromEnv
case Maybe Credentials
envcr of
Just Credentials
cr -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Credentials
cr)
Maybe Credentials
Nothing -> forall (io :: * -> *).
MonadIO io =>
String -> Text -> io (Maybe Credentials)
loadCredentialsFromFile String
file Text
key
loadCredentialsFromEnvOrFileOrInstanceMetadata :: MonadIO io => FilePath -> T.Text -> io (Maybe Credentials)
loadCredentialsFromEnvOrFileOrInstanceMetadata :: forall (io :: * -> *).
MonadIO io =>
String -> Text -> io (Maybe Credentials)
loadCredentialsFromEnvOrFileOrInstanceMetadata String
file Text
key =
do
Maybe Credentials
envcr <- forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
loadCredentialsFromEnv
case Maybe Credentials
envcr of
Just Credentials
cr -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Credentials
cr)
Maybe Credentials
Nothing ->
do
Maybe Credentials
filecr <- forall (io :: * -> *).
MonadIO io =>
String -> Text -> io (Maybe Credentials)
loadCredentialsFromFile String
file Text
key
case Maybe Credentials
filecr of
Just Credentials
cr -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Credentials
cr)
Maybe Credentials
Nothing -> forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
loadCredentialsFromInstanceMetadata
loadCredentialsDefault :: MonadIO io => io (Maybe Credentials)
loadCredentialsDefault :: forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
loadCredentialsDefault = do
Maybe String
mfile <- forall (io :: * -> *). MonadIO io => io (Maybe String)
credentialsDefaultFile
case Maybe String
mfile of
Just String
file -> forall (io :: * -> *).
MonadIO io =>
String -> Text -> io (Maybe Credentials)
loadCredentialsFromEnvOrFileOrInstanceMetadata String
file Text
credentialsDefaultKey
Maybe String
Nothing -> forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
loadCredentialsFromEnv
anonymousCredentials :: MonadIO io => io Credentials
anonymousCredentials :: forall (io :: * -> *). MonadIO io => io Credentials
anonymousCredentials = do
Credentials
cr <- forall (io :: * -> *).
MonadIO io =>
ByteString -> ByteString -> io Credentials
makeCredentials forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
forall (m :: * -> *) a. Monad m => a -> m a
return (Credentials
cr { isAnonymousCredentials :: Bool
isAnonymousCredentials = Bool
True })
data Protocol
= HTTP
| HTTPS
deriving (Protocol -> Protocol -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Protocol -> Protocol -> Bool
$c/= :: Protocol -> Protocol -> Bool
== :: Protocol -> Protocol -> Bool
$c== :: Protocol -> Protocol -> Bool
Eq,ReadPrec [Protocol]
ReadPrec Protocol
Int -> ReadS Protocol
ReadS [Protocol]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Protocol]
$creadListPrec :: ReadPrec [Protocol]
readPrec :: ReadPrec Protocol
$creadPrec :: ReadPrec Protocol
readList :: ReadS [Protocol]
$creadList :: ReadS [Protocol]
readsPrec :: Int -> ReadS Protocol
$creadsPrec :: Int -> ReadS Protocol
Read,Int -> Protocol -> ShowS
[Protocol] -> ShowS
Protocol -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Protocol] -> ShowS
$cshowList :: [Protocol] -> ShowS
show :: Protocol -> String
$cshow :: Protocol -> String
showsPrec :: Int -> Protocol -> ShowS
$cshowsPrec :: Int -> Protocol -> ShowS
Show,Eq Protocol
Protocol -> Protocol -> Bool
Protocol -> Protocol -> Ordering
Protocol -> Protocol -> Protocol
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Protocol -> Protocol -> Protocol
$cmin :: Protocol -> Protocol -> Protocol
max :: Protocol -> Protocol -> Protocol
$cmax :: Protocol -> Protocol -> Protocol
>= :: Protocol -> Protocol -> Bool
$c>= :: Protocol -> Protocol -> Bool
> :: Protocol -> Protocol -> Bool
$c> :: Protocol -> Protocol -> Bool
<= :: Protocol -> Protocol -> Bool
$c<= :: Protocol -> Protocol -> Bool
< :: Protocol -> Protocol -> Bool
$c< :: Protocol -> Protocol -> Bool
compare :: Protocol -> Protocol -> Ordering
$ccompare :: Protocol -> Protocol -> Ordering
Ord,Typeable)
defaultPort :: Protocol -> Int
defaultPort :: Protocol -> Int
defaultPort Protocol
HTTP = Int
80
defaultPort Protocol
HTTPS = Int
443
data Method
= Head
| Get
| PostQuery
| Post
| Put
| Delete
deriving (Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Method] -> ShowS
$cshowList :: [Method] -> ShowS
show :: Method -> String
$cshow :: Method -> String
showsPrec :: Int -> Method -> ShowS
$cshowsPrec :: Int -> Method -> ShowS
Show, Method -> Method -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c== :: Method -> Method -> Bool
Eq, Eq Method
Method -> Method -> Bool
Method -> Method -> Ordering
Method -> Method -> Method
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Method -> Method -> Method
$cmin :: Method -> Method -> Method
max :: Method -> Method -> Method
$cmax :: Method -> Method -> Method
>= :: Method -> Method -> Bool
$c>= :: Method -> Method -> Bool
> :: Method -> Method -> Bool
$c> :: Method -> Method -> Bool
<= :: Method -> Method -> Bool
$c<= :: Method -> Method -> Bool
< :: Method -> Method -> Bool
$c< :: Method -> Method -> Bool
compare :: Method -> Method -> Ordering
$ccompare :: Method -> Method -> Ordering
Ord)
httpMethod :: Method -> HTTP.Method
httpMethod :: Method -> ByteString
httpMethod Method
Head = ByteString
"HEAD"
httpMethod Method
Get = ByteString
"GET"
httpMethod Method
PostQuery = ByteString
"POST"
httpMethod Method
Post = ByteString
"POST"
httpMethod Method
Put = ByteString
"PUT"
httpMethod Method
Delete = ByteString
"DELETE"
data SignedQuery
= SignedQuery {
SignedQuery -> Method
sqMethod :: !Method
, SignedQuery -> Protocol
sqProtocol :: !Protocol
, SignedQuery -> ByteString
sqHost :: !B.ByteString
, SignedQuery -> Int
sqPort :: !Int
, SignedQuery -> ByteString
sqPath :: !B.ByteString
, SignedQuery -> Query
sqQuery :: !HTTP.Query
, SignedQuery -> Maybe UTCTime
sqDate :: !(Maybe UTCTime)
, SignedQuery -> Maybe (IO ByteString)
sqAuthorization :: !(Maybe (IO B.ByteString))
, SignedQuery -> Maybe ByteString
sqContentType :: !(Maybe B.ByteString)
, SignedQuery -> Maybe (Digest MD5)
sqContentMd5 :: !(Maybe (CH.Digest CH.MD5))
, :: !HTTP.RequestHeaders
, :: !HTTP.RequestHeaders
, SignedQuery -> Maybe RequestBody
sqBody :: !(Maybe HTTP.RequestBody)
, SignedQuery -> ByteString
sqStringToSign :: !B.ByteString
}
queryToHttpRequest :: SignedQuery -> IO HTTP.Request
queryToHttpRequest :: SignedQuery -> IO Request
queryToHttpRequest SignedQuery{Int
Query
RequestHeaders
Maybe (IO ByteString)
Maybe ByteString
Maybe UTCTime
Maybe (Digest MD5)
Maybe RequestBody
ByteString
Method
Protocol
sqStringToSign :: ByteString
sqBody :: Maybe RequestBody
sqOtherHeaders :: RequestHeaders
sqAmzHeaders :: RequestHeaders
sqContentMd5 :: Maybe (Digest MD5)
sqContentType :: Maybe ByteString
sqAuthorization :: Maybe (IO ByteString)
sqDate :: Maybe UTCTime
sqQuery :: Query
sqPath :: ByteString
sqPort :: Int
sqHost :: ByteString
sqProtocol :: Protocol
sqMethod :: Method
sqStringToSign :: SignedQuery -> ByteString
sqBody :: SignedQuery -> Maybe RequestBody
sqOtherHeaders :: SignedQuery -> RequestHeaders
sqAmzHeaders :: SignedQuery -> RequestHeaders
sqContentMd5 :: SignedQuery -> Maybe (Digest MD5)
sqContentType :: SignedQuery -> Maybe ByteString
sqAuthorization :: SignedQuery -> Maybe (IO ByteString)
sqDate :: SignedQuery -> Maybe UTCTime
sqQuery :: SignedQuery -> Query
sqPath :: SignedQuery -> ByteString
sqPort :: SignedQuery -> Int
sqHost :: SignedQuery -> ByteString
sqProtocol :: SignedQuery -> Protocol
sqMethod :: SignedQuery -> Method
..} = do
Maybe ByteString
mauth <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Justforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) Maybe (IO ByteString)
sqAuthorization
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Request
HTTP.defaultRequest {
method :: ByteString
HTTP.method = Method -> ByteString
httpMethod Method
sqMethod
, secure :: Bool
HTTP.secure = case Protocol
sqProtocol of
Protocol
HTTP -> Bool
False
Protocol
HTTPS -> Bool
True
, host :: ByteString
HTTP.host = ByteString
sqHost
, port :: Int
HTTP.port = Int
sqPort
, path :: ByteString
HTTP.path = ByteString
sqPath
, queryString :: ByteString
HTTP.queryString =
if Method
sqMethod forall a. Eq a => a -> a -> Bool
== Method
PostQuery
then ByteString
""
else Bool -> Query -> ByteString
HTTP.renderQuery Bool
False Query
sqQuery
, requestHeaders :: RequestHeaders
HTTP.requestHeaders = forall a. [Maybe a] -> [a]
catMaybes [ (UTCTime -> Header) -> Maybe UTCTime -> Maybe Header
checkDate (\UTCTime
d -> (HeaderName
"Date", UTCTime -> ByteString
fmtRfc822Time UTCTime
d)) Maybe UTCTime
sqDate
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ByteString
c -> (HeaderName
"Content-Type", ByteString
c)) Maybe ByteString
contentType
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Digest MD5
md5 -> (HeaderName
"Content-MD5", ByteString -> ByteString
Base64.encode forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert Digest MD5
md5)) Maybe (Digest MD5)
sqContentMd5
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ByteString
auth -> (HeaderName
"Authorization", ByteString
auth)) Maybe ByteString
mauth]
forall a. [a] -> [a] -> [a]
++ RequestHeaders
sqAmzHeaders
forall a. [a] -> [a] -> [a]
++ RequestHeaders
sqOtherHeaders
, requestBody :: RequestBody
HTTP.requestBody =
case Maybe RequestBody
sqBody of
Just RequestBody
x -> RequestBody
x
Maybe RequestBody
Nothing ->
case Method
sqMethod of
Method
PostQuery -> ByteString -> RequestBody
HTTP.RequestBodyLBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Blaze.toLazyByteString forall a b. (a -> b) -> a -> b
$
Bool -> Query -> Builder
HTTP.renderQueryBuilder Bool
False Query
sqQuery
Method
_ -> Int64 -> Builder -> RequestBody
HTTP.RequestBodyBuilder Int64
0 forall a. Monoid a => a
mempty
, decompress :: ByteString -> Bool
HTTP.decompress = ByteString -> Bool
HTTP.alwaysDecompress
#if MIN_VERSION_http_conduit(2,2,0)
, checkResponse :: Request -> Response (IO ByteString) -> IO ()
HTTP.checkResponse = \Request
_ Response (IO ByteString)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
, HTTP.checkStatus = \_ _ _-> Nothing
#endif
, redirectCount :: Int
HTTP.redirectCount = Int
10
}
where
checkDate :: (UTCTime -> Header) -> Maybe UTCTime -> Maybe Header
checkDate UTCTime -> Header
f Maybe UTCTime
mb = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UTCTime -> Header
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
mb) (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"date" RequestHeaders
sqOtherHeaders
contentType :: Maybe ByteString
contentType = Maybe ByteString
sqContentType forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe ByteString
defContentType
defContentType :: Maybe ByteString
defContentType = case Method
sqMethod of
Method
PostQuery -> forall a. a -> Maybe a
Just ByteString
"application/x-www-form-urlencoded; charset=utf-8"
Method
_ -> forall a. Maybe a
Nothing
queryToUri :: SignedQuery -> B.ByteString
queryToUri :: SignedQuery -> ByteString
queryToUri SignedQuery{Int
Query
RequestHeaders
Maybe (IO ByteString)
Maybe ByteString
Maybe UTCTime
Maybe (Digest MD5)
Maybe RequestBody
ByteString
Method
Protocol
sqStringToSign :: ByteString
sqBody :: Maybe RequestBody
sqOtherHeaders :: RequestHeaders
sqAmzHeaders :: RequestHeaders
sqContentMd5 :: Maybe (Digest MD5)
sqContentType :: Maybe ByteString
sqAuthorization :: Maybe (IO ByteString)
sqDate :: Maybe UTCTime
sqQuery :: Query
sqPath :: ByteString
sqPort :: Int
sqHost :: ByteString
sqProtocol :: Protocol
sqMethod :: Method
sqStringToSign :: SignedQuery -> ByteString
sqBody :: SignedQuery -> Maybe RequestBody
sqOtherHeaders :: SignedQuery -> RequestHeaders
sqAmzHeaders :: SignedQuery -> RequestHeaders
sqContentMd5 :: SignedQuery -> Maybe (Digest MD5)
sqContentType :: SignedQuery -> Maybe ByteString
sqAuthorization :: SignedQuery -> Maybe (IO ByteString)
sqDate :: SignedQuery -> Maybe UTCTime
sqQuery :: SignedQuery -> Query
sqPath :: SignedQuery -> ByteString
sqPort :: SignedQuery -> Int
sqHost :: SignedQuery -> ByteString
sqProtocol :: SignedQuery -> Protocol
sqMethod :: SignedQuery -> Method
..}
= [ByteString] -> ByteString
B.concat [
case Protocol
sqProtocol of
Protocol
HTTP -> ByteString
"http://"
Protocol
HTTPS -> ByteString
"https://"
, ByteString
sqHost
, if Int
sqPort forall a. Eq a => a -> a -> Bool
== Protocol -> Int
defaultPort Protocol
sqProtocol then ByteString
"" else Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Char
':' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
sqPort
, ByteString
sqPath
, Bool -> Query -> ByteString
HTTP.renderQuery Bool
True Query
sqQuery
]
data TimeInfo
= Timestamp
| ExpiresAt { TimeInfo -> UTCTime
fromExpiresAt :: UTCTime }
| ExpiresIn { TimeInfo -> NominalDiffTime
fromExpiresIn :: NominalDiffTime }
deriving (Int -> TimeInfo -> ShowS
[TimeInfo] -> ShowS
TimeInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeInfo] -> ShowS
$cshowList :: [TimeInfo] -> ShowS
show :: TimeInfo -> String
$cshow :: TimeInfo -> String
showsPrec :: Int -> TimeInfo -> ShowS
$cshowsPrec :: Int -> TimeInfo -> ShowS
Show)
data AbsoluteTimeInfo
= AbsoluteTimestamp { AbsoluteTimeInfo -> UTCTime
fromAbsoluteTimestamp :: UTCTime }
| AbsoluteExpires { AbsoluteTimeInfo -> UTCTime
fromAbsoluteExpires :: UTCTime }
deriving (Int -> AbsoluteTimeInfo -> ShowS
[AbsoluteTimeInfo] -> ShowS
AbsoluteTimeInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbsoluteTimeInfo] -> ShowS
$cshowList :: [AbsoluteTimeInfo] -> ShowS
show :: AbsoluteTimeInfo -> String
$cshow :: AbsoluteTimeInfo -> String
showsPrec :: Int -> AbsoluteTimeInfo -> ShowS
$cshowsPrec :: Int -> AbsoluteTimeInfo -> ShowS
Show)
fromAbsoluteTimeInfo :: AbsoluteTimeInfo -> UTCTime
fromAbsoluteTimeInfo :: AbsoluteTimeInfo -> UTCTime
fromAbsoluteTimeInfo (AbsoluteTimestamp UTCTime
time) = UTCTime
time
fromAbsoluteTimeInfo (AbsoluteExpires UTCTime
time) = UTCTime
time
makeAbsoluteTimeInfo :: TimeInfo -> UTCTime -> AbsoluteTimeInfo
makeAbsoluteTimeInfo :: TimeInfo -> UTCTime -> AbsoluteTimeInfo
makeAbsoluteTimeInfo TimeInfo
Timestamp UTCTime
now = UTCTime -> AbsoluteTimeInfo
AbsoluteTimestamp UTCTime
now
makeAbsoluteTimeInfo (ExpiresAt UTCTime
t) UTCTime
_ = UTCTime -> AbsoluteTimeInfo
AbsoluteExpires UTCTime
t
makeAbsoluteTimeInfo (ExpiresIn NominalDiffTime
s) UTCTime
now = UTCTime -> AbsoluteTimeInfo
AbsoluteExpires forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
s UTCTime
now
data SignatureData
= SignatureData {
SignatureData -> AbsoluteTimeInfo
signatureTimeInfo :: AbsoluteTimeInfo
, SignatureData -> UTCTime
signatureTime :: UTCTime
, SignatureData -> Credentials
signatureCredentials :: Credentials
}
signatureData :: TimeInfo -> Credentials -> IO SignatureData
signatureData :: TimeInfo -> Credentials -> IO SignatureData
signatureData TimeInfo
rti Credentials
cr = do
UTCTime
now <- IO UTCTime
getCurrentTime
let ti :: AbsoluteTimeInfo
ti = TimeInfo -> UTCTime -> AbsoluteTimeInfo
makeAbsoluteTimeInfo TimeInfo
rti UTCTime
now
forall (m :: * -> *) a. Monad m => a -> m a
return SignatureData { signatureTimeInfo :: AbsoluteTimeInfo
signatureTimeInfo = AbsoluteTimeInfo
ti, signatureTime :: UTCTime
signatureTime = UTCTime
now, signatureCredentials :: Credentials
signatureCredentials = Credentials
cr }
data NormalQuery
data UriOnlyQuery
class SignQuery request where
type ServiceConfiguration request :: * -> *
signQuery :: request -> ServiceConfiguration request queryType -> SignatureData -> SignedQuery
data AuthorizationHash
= HmacSHA1
| HmacSHA256
deriving (Int -> AuthorizationHash -> ShowS
[AuthorizationHash] -> ShowS
AuthorizationHash -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizationHash] -> ShowS
$cshowList :: [AuthorizationHash] -> ShowS
show :: AuthorizationHash -> String
$cshow :: AuthorizationHash -> String
showsPrec :: Int -> AuthorizationHash -> ShowS
$cshowsPrec :: Int -> AuthorizationHash -> ShowS
Show)
amzHash :: AuthorizationHash -> B.ByteString
amzHash :: AuthorizationHash -> ByteString
amzHash AuthorizationHash
HmacSHA1 = ByteString
"HmacSHA1"
amzHash AuthorizationHash
HmacSHA256 = ByteString
"HmacSHA256"
signature :: Credentials -> AuthorizationHash -> B.ByteString -> B.ByteString
signature :: Credentials -> AuthorizationHash -> ByteString -> ByteString
signature Credentials
cr AuthorizationHash
ah ByteString
input = ByteString -> ByteString
Base64.encode ByteString
sig
where
sig :: ByteString
sig = case AuthorizationHash
ah of
AuthorizationHash
HmacSHA1 -> forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
CMH.hmac (Credentials -> ByteString
secretAccessKey Credentials
cr) ByteString
input :: CMH.HMAC CH.SHA1)
AuthorizationHash
HmacSHA256 -> forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
CMH.hmac (Credentials -> ByteString
secretAccessKey Credentials
cr) ByteString
input :: CMH.HMAC CH.SHA256)
credentialV4
:: SignatureData
-> B.ByteString
-> B.ByteString
-> B.ByteString
credentialV4 :: SignatureData -> ByteString -> ByteString -> ByteString
credentialV4 SignatureData
sd ByteString
region ByteString
service = [ByteString] -> ByteString
B.concat
[ Credentials -> ByteString
accessKeyID (SignatureData -> Credentials
signatureCredentials SignatureData
sd)
, ByteString
"/"
, ByteString
date
, ByteString
"/"
, ByteString
region
, ByteString
"/"
, ByteString
service
, ByteString
"/aws4_request"
]
where
date :: ByteString
date = String -> UTCTime -> ByteString
fmtTime String
"%Y%m%d" forall a b. (a -> b) -> a -> b
$ SignatureData -> UTCTime
signatureTime SignatureData
sd
authorizationV4 :: SignatureData
-> AuthorizationHash
-> B.ByteString
-> B.ByteString
-> B.ByteString
-> B.ByteString
-> IO B.ByteString
authorizationV4 :: SignatureData
-> AuthorizationHash
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> IO ByteString
authorizationV4 SignatureData
sd AuthorizationHash
ah ByteString
region ByteString
service ByteString
headers ByteString
canonicalRequest = do
let ref :: IORef [V4Key]
ref = Credentials -> IORef [V4Key]
v4SigningKeys forall a b. (a -> b) -> a -> b
$ SignatureData -> Credentials
signatureCredentials SignatureData
sd
date :: ByteString
date = String -> UTCTime -> ByteString
fmtTime String
"%Y%m%d" forall a b. (a -> b) -> a -> b
$ SignatureData -> UTCTime
signatureTime SignatureData
sd
[V4Key]
allkeys <- forall a. IORef a -> IO a
readIORef IORef [V4Key]
ref
let mkey :: Maybe ByteString
mkey = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ByteString
region,ByteString
service) [V4Key]
allkeys of
Just (ByteString
d,ByteString
k) | ByteString
d forall a. Eq a => a -> a -> Bool
/= ByteString
date -> forall a. Maybe a
Nothing
| Bool
otherwise -> forall a. a -> Maybe a
Just ByteString
k
Maybe (ByteString, ByteString)
Nothing -> forall a. Maybe a
Nothing
let createNewKey :: IO ByteString
createNewKey = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [V4Key]
ref forall a b. (a -> b) -> a -> b
$ \[V4Key]
keylist ->
let kSigning :: ByteString
kSigning = SignatureData
-> AuthorizationHash -> ByteString -> ByteString -> ByteString
signingKeyV4 SignatureData
sd AuthorizationHash
ah ByteString
region ByteString
service
lstK :: (ByteString, ByteString)
lstK = (ByteString
region,ByteString
service)
keylist' :: [V4Key]
keylist' = ((ByteString, ByteString)
lstK,(ByteString
date,ByteString
kSigning)) forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (((ByteString, ByteString)
lstKforall a. Eq a => a -> a -> Bool
/=)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) [V4Key]
keylist
in ([V4Key]
keylist', ByteString
kSigning)
SignatureData
-> AuthorizationHash
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
constructAuthorizationV4Header SignatureData
sd AuthorizationHash
ah ByteString
region ByteString
service ByteString
headers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignatureData
-> AuthorizationHash
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
signatureV4WithKey SignatureData
sd AuthorizationHash
ah ByteString
region ByteString
service ByteString
canonicalRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ByteString
createNewKey forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
mkey
authorizationV4'
:: SignatureData
-> AuthorizationHash
-> B.ByteString
-> B.ByteString
-> B.ByteString
-> B.ByteString
-> B.ByteString
authorizationV4' :: SignatureData
-> AuthorizationHash
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
authorizationV4' SignatureData
sd AuthorizationHash
ah ByteString
region ByteString
service ByteString
headers ByteString
canonicalRequest
= SignatureData
-> AuthorizationHash
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
constructAuthorizationV4Header SignatureData
sd AuthorizationHash
ah ByteString
region ByteString
service ByteString
headers
forall a b. (a -> b) -> a -> b
$ SignatureData
-> AuthorizationHash
-> ByteString
-> ByteString
-> ByteString
-> ByteString
signatureV4 SignatureData
sd AuthorizationHash
ah ByteString
region ByteString
service ByteString
canonicalRequest
constructAuthorizationV4Header
:: SignatureData
-> AuthorizationHash
-> B.ByteString
-> B.ByteString
-> B.ByteString
-> B.ByteString
-> B.ByteString
SignatureData
sd AuthorizationHash
ah ByteString
region ByteString
service ByteString
headers ByteString
sig = [ByteString] -> ByteString
B.concat
[ ByteString
alg
, ByteString
" Credential="
, SignatureData -> ByteString -> ByteString -> ByteString
credentialV4 SignatureData
sd ByteString
region ByteString
service
, ByteString
",SignedHeaders="
, ByteString
headers
, ByteString
",Signature="
, ByteString
sig
]
where
alg :: ByteString
alg = case AuthorizationHash
ah of
AuthorizationHash
HmacSHA1 -> ByteString
"AWS4-HMAC-SHA1"
AuthorizationHash
HmacSHA256 -> ByteString
"AWS4-HMAC-SHA256"
signatureV4WithKey
:: SignatureData
-> AuthorizationHash
-> B.ByteString
-> B.ByteString
-> B.ByteString
-> B.ByteString
-> B.ByteString
signatureV4WithKey :: SignatureData
-> AuthorizationHash
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
signatureV4WithKey SignatureData
sd AuthorizationHash
ah ByteString
region ByteString
service ByteString
canonicalRequest ByteString
key = ByteString -> ByteString
Base16.encode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
mkHmac ByteString
key ByteString
stringToSign
where
date :: ByteString
date = String -> UTCTime -> ByteString
fmtTime String
"%Y%m%d" forall a b. (a -> b) -> a -> b
$ SignatureData -> UTCTime
signatureTime SignatureData
sd
mkHmac :: ByteString -> ByteString -> ByteString
mkHmac ByteString
k ByteString
i = case AuthorizationHash
ah of
AuthorizationHash
HmacSHA1 -> forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
CMH.hmac ByteString
k ByteString
i :: CMH.HMAC CH.SHA1)
AuthorizationHash
HmacSHA256 -> forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
CMH.hmac ByteString
k ByteString
i :: CMH.HMAC CH.SHA256)
mkHash :: ByteString -> ByteString
mkHash ByteString
i = case AuthorizationHash
ah of
AuthorizationHash
HmacSHA1 -> forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash ByteString
i :: CH.Digest CH.SHA1)
AuthorizationHash
HmacSHA256 -> forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash ByteString
i :: CH.Digest CH.SHA256)
alg :: ByteString
alg = case AuthorizationHash
ah of
AuthorizationHash
HmacSHA1 -> ByteString
"AWS4-HMAC-SHA1"
AuthorizationHash
HmacSHA256 -> ByteString
"AWS4-HMAC-SHA256"
canonicalRequestHash :: ByteString
canonicalRequestHash = ByteString -> ByteString
Base16.encode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
mkHash ByteString
canonicalRequest
stringToSign :: ByteString
stringToSign = [ByteString] -> ByteString
B.concat
[ ByteString
alg
, ByteString
"\n"
, String -> UTCTime -> ByteString
fmtTime String
"%Y%m%dT%H%M%SZ" forall a b. (a -> b) -> a -> b
$ SignatureData -> UTCTime
signatureTime SignatureData
sd
, ByteString
"\n"
, ByteString
date
, ByteString
"/"
, ByteString
region
, ByteString
"/"
, ByteString
service
, ByteString
"/aws4_request\n"
, ByteString
canonicalRequestHash
]
signingKeyV4
:: SignatureData
-> AuthorizationHash
-> B.ByteString
-> B.ByteString
-> B.ByteString
signingKeyV4 :: SignatureData
-> AuthorizationHash -> ByteString -> ByteString -> ByteString
signingKeyV4 SignatureData
sd AuthorizationHash
ah ByteString
region ByteString
service = ByteString
kSigning
where
mkHmac :: ByteString -> ByteString -> ByteString
mkHmac ByteString
k ByteString
i = case AuthorizationHash
ah of
AuthorizationHash
HmacSHA1 -> forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
CMH.hmac ByteString
k ByteString
i :: CMH.HMAC CH.SHA1)
AuthorizationHash
HmacSHA256 -> forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
CMH.hmac ByteString
k ByteString
i :: CMH.HMAC CH.SHA256)
date :: ByteString
date = String -> UTCTime -> ByteString
fmtTime String
"%Y%m%d" forall a b. (a -> b) -> a -> b
$ SignatureData -> UTCTime
signatureTime SignatureData
sd
secretKey :: ByteString
secretKey = Credentials -> ByteString
secretAccessKey forall a b. (a -> b) -> a -> b
$ SignatureData -> Credentials
signatureCredentials SignatureData
sd
kDate :: ByteString
kDate = ByteString -> ByteString -> ByteString
mkHmac (ByteString
"AWS4" forall a. Semigroup a => a -> a -> a
<> ByteString
secretKey) ByteString
date
kRegion :: ByteString
kRegion = ByteString -> ByteString -> ByteString
mkHmac ByteString
kDate ByteString
region
kService :: ByteString
kService = ByteString -> ByteString -> ByteString
mkHmac ByteString
kRegion ByteString
service
kSigning :: ByteString
kSigning = ByteString -> ByteString -> ByteString
mkHmac ByteString
kService ByteString
"aws4_request"
signatureV4
:: SignatureData
-> AuthorizationHash
-> B.ByteString
-> B.ByteString
-> B.ByteString
-> B.ByteString
signatureV4 :: SignatureData
-> AuthorizationHash
-> ByteString
-> ByteString
-> ByteString
-> ByteString
signatureV4 SignatureData
sd AuthorizationHash
ah ByteString
region ByteString
service ByteString
canonicalRequest
= SignatureData
-> AuthorizationHash
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
signatureV4WithKey SignatureData
sd AuthorizationHash
ah ByteString
region ByteString
service ByteString
canonicalRequest
forall a b. (a -> b) -> a -> b
$ SignatureData
-> AuthorizationHash -> ByteString -> ByteString -> ByteString
signingKeyV4 SignatureData
sd AuthorizationHash
ah ByteString
region ByteString
service
class DefaultServiceConfiguration config where
defServiceConfig :: config
debugServiceConfig :: config
debugServiceConfig = forall config. DefaultServiceConfiguration config => config
defServiceConfig
queryList :: (a -> [(B.ByteString, B.ByteString)]) -> B.ByteString -> [a] -> [(B.ByteString, B.ByteString)]
queryList :: forall a.
(a -> [(ByteString, ByteString)])
-> ByteString -> [a] -> [(ByteString, ByteString)]
queryList a -> [(ByteString, ByteString)]
f ByteString
prefix [a]
xs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {d}. ByteString -> [(ByteString, d)] -> [(ByteString, d)]
combine [ByteString]
prefixList (forall a b. (a -> b) -> [a] -> [b]
map a -> [(ByteString, ByteString)]
f [a]
xs)
where prefixList :: [ByteString]
prefixList = forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> ByteString -> ByteString
dot ByteString
prefix forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BU.fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [(Int
1 :: Int) ..]
combine :: ByteString -> [(ByteString, d)] -> [(ByteString, d)]
combine ByteString
pf = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (ByteString
pf ByteString -> ByteString -> ByteString
`dot`)
dot :: ByteString -> ByteString -> ByteString
dot ByteString
x ByteString
y = [ByteString] -> ByteString
B.concat [ByteString
x, String -> ByteString
BU.fromString String
".", ByteString
y]
awsBool :: Bool -> B.ByteString
awsBool :: Bool -> ByteString
awsBool Bool
True = ByteString
"true"
awsBool Bool
False = ByteString
"false"
awsTrue :: B.ByteString
awsTrue :: ByteString
awsTrue = Bool -> ByteString
awsBool Bool
True
awsFalse :: B.ByteString
awsFalse :: ByteString
awsFalse = Bool -> ByteString
awsBool Bool
False
fmtTime :: String -> UTCTime -> B.ByteString
fmtTime :: String -> UTCTime -> ByteString
fmtTime String
s UTCTime
t = String -> ByteString
BU.fromString forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
s UTCTime
t
rfc822Time :: String
rfc822Time :: String
rfc822Time = String
"%a, %0d %b %Y %H:%M:%S GMT"
fmtRfc822Time :: UTCTime -> B.ByteString
fmtRfc822Time :: UTCTime -> ByteString
fmtRfc822Time = String -> UTCTime -> ByteString
fmtTime String
rfc822Time
fmtAmzTime :: UTCTime -> B.ByteString
fmtAmzTime :: UTCTime -> ByteString
fmtAmzTime = String -> UTCTime -> ByteString
fmtTime String
"%Y-%m-%dT%H:%M:%S"
fmtTimeEpochSeconds :: UTCTime -> B.ByteString
fmtTimeEpochSeconds :: UTCTime -> ByteString
fmtTimeEpochSeconds = String -> UTCTime -> ByteString
fmtTime String
"%s"
parseHttpDate :: String -> Maybe UTCTime
parseHttpDate :: String -> Maybe UTCTime
parseHttpDate String
s = String -> String -> Maybe UTCTime
p String
"%a, %d %b %Y %H:%M:%S GMT" String
s
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> String -> Maybe UTCTime
p String
"%A, %d-%b-%y %H:%M:%S GMT" String
s
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> String -> Maybe UTCTime
p String
"%a %b %_d %H:%M:%S %Y" String
s
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> String -> Maybe UTCTime
p String
"%Y-%m-%dT%H:%M:%S%QZ" String
s
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> String -> Maybe UTCTime
p String
"%Y-%m-%dT%H:%M:%S%Q%Z" String
s
where p :: String -> String -> Maybe UTCTime
p = forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale
httpDate1 :: String
httpDate1 :: String
httpDate1 = String
"%a, %d %b %Y %H:%M:%S GMT"
textHttpDate :: UTCTime -> T.Text
textHttpDate :: UTCTime -> Text
textHttpDate = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
httpDate1
iso8601UtcDate :: String
iso8601UtcDate :: String
iso8601UtcDate = String
"%Y-%m-%dT%H:%M:%S%QZ"
readHex2 :: [Char] -> Maybe Word8
readHex2 :: String -> Maybe Word8
readHex2 [Char
c1,Char
c2] = do Int
n1 <- Char -> Maybe Int
readHex1 Char
c1
Int
n2 <- Char -> Maybe Int
readHex1 Char
c2
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
n1 forall a. Num a => a -> a -> a
* Int
16 forall a. Num a => a -> a -> a
+ Int
n2
where
readHex1 :: Char -> Maybe Int
readHex1 Char
c | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'
| Char
c forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'F' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' forall a. Num a => a -> a -> a
+ Int
10
| Char
c forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'f' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' forall a. Num a => a -> a -> a
+ Int
10
readHex1 Char
_ = forall a. Maybe a
Nothing
readHex2 String
_ = forall a. Maybe a
Nothing
newtype XmlException = XmlException { XmlException -> String
xmlErrorMessage :: String }
deriving (Int -> XmlException -> ShowS
[XmlException] -> ShowS
XmlException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XmlException] -> ShowS
$cshowList :: [XmlException] -> ShowS
show :: XmlException -> String
$cshow :: XmlException -> String
showsPrec :: Int -> XmlException -> ShowS
$cshowsPrec :: Int -> XmlException -> ShowS
Show, Typeable)
instance E.Exception XmlException
newtype = { :: String }
deriving (Int -> HeaderException -> ShowS
[HeaderException] -> ShowS
HeaderException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderException] -> ShowS
$cshowList :: [HeaderException] -> ShowS
show :: HeaderException -> String
$cshow :: HeaderException -> String
showsPrec :: Int -> HeaderException -> ShowS
$cshowsPrec :: Int -> HeaderException -> ShowS
Show, Typeable)
instance E.Exception HeaderException
newtype FormException = FormException { FormException -> String
formErrorMesage :: String }
deriving (Int -> FormException -> ShowS
[FormException] -> ShowS
FormException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormException] -> ShowS
$cshowList :: [FormException] -> ShowS
show :: FormException -> String
$cshow :: FormException -> String
showsPrec :: Int -> FormException -> ShowS
$cshowsPrec :: Int -> FormException -> ShowS
Show, Typeable)
instance E.Exception FormException
newtype NoCredentialsException = NoCredentialsException { NoCredentialsException -> String
noCredentialsErrorMessage :: String }
deriving (Int -> NoCredentialsException -> ShowS
[NoCredentialsException] -> ShowS
NoCredentialsException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoCredentialsException] -> ShowS
$cshowList :: [NoCredentialsException] -> ShowS
show :: NoCredentialsException -> String
$cshow :: NoCredentialsException -> String
showsPrec :: Int -> NoCredentialsException -> ShowS
$cshowsPrec :: Int -> NoCredentialsException -> ShowS
Show, Typeable)
instance E.Exception NoCredentialsException
throwStatusCodeException :: MonadThrow m => HTTP.Request -> HTTP.Response (C.ConduitM () ByteString m ()) -> m a
throwStatusCodeException :: forall (m :: * -> *) a.
MonadThrow m =>
Request -> Response (ConduitM () ByteString m ()) -> m a
throwStatusCodeException Request
req Response (ConduitM () ByteString m ())
resp = do
let resp' :: Response ()
resp' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) Response (ConduitM () ByteString m ())
resp
ByteString
body <- forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
HTTP.responseBody Response (ConduitM () ByteString m ())
resp forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
Monad m =>
Int -> ConduitT ByteString o m ByteString
CB.take (Int
10forall a. Num a => a -> a -> a
*Int
1024)
let sce :: HttpExceptionContent
sce = Response () -> ByteString -> HttpExceptionContent
HTTP.StatusCodeException Response ()
resp' (ByteString -> ByteString
L.toStrict ByteString
body)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Request -> HttpExceptionContent -> HttpException
HTTP.HttpExceptionRequest Request
req HttpExceptionContent
sce
elContent :: T.Text -> Cursor -> [T.Text]
elContent :: Text -> Cursor -> [Text]
elContent Text
name = Text -> Axis
laxElement Text
name forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
elCont :: T.Text -> Cursor -> [String]
elCont :: Text -> Cursor -> [String]
elCont Text
name = Text -> Axis
laxElement Text
name forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Text -> String
T.unpack
force :: MonadThrow m => String -> [a] -> m a
force :: forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force = forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [a] -> f a
Cu.force forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> XmlException
XmlException
forceM :: MonadThrow m => String -> [m a] -> m a
forceM :: forall (m :: * -> *) a. MonadThrow m => String -> [m a] -> m a
forceM = forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [f a] -> f a
Cu.forceM forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> XmlException
XmlException
textReadBool :: MonadThrow m => T.Text -> m Bool
textReadBool :: forall (m :: * -> *). MonadThrow m => Text -> m Bool
textReadBool Text
s = case Text -> String
T.unpack Text
s of
String
"true" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
String
"false" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
String
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> XmlException
XmlException String
"Invalid Bool"
textReadInt :: (MonadThrow m, Num a) => T.Text -> m a
textReadInt :: forall (m :: * -> *) a. (MonadThrow m, Num a) => Text -> m a
textReadInt Text
s = case forall a. Read a => ReadS a
reads forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s of
[(Integer
n,String
"")] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
n
[(Integer, String)]
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> XmlException
XmlException String
"Invalid Integer"
readInt :: (MonadThrow m, Num a) => String -> m a
readInt :: forall (m :: * -> *) a. (MonadThrow m, Num a) => String -> m a
readInt String
s = case forall a. Read a => ReadS a
reads String
s of
[(Integer
n,String
"")] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
n
[(Integer, String)]
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> XmlException
XmlException String
"Invalid Integer"
xmlCursorConsumer ::
(Monoid m)
=> (Cu.Cursor -> Response m a)
-> IORef m
-> HTTPResponseConsumer a
xmlCursorConsumer :: forall m a.
Monoid m =>
(Cursor -> Response m a) -> IORef m -> HTTPResponseConsumer a
xmlCursorConsumer Cursor -> Response m a
parse IORef m
metadataRef Response (ConduitM () ByteString (ResourceT IO) ())
res
= do Document
doc <- forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
HTTP.responseBody Response (ConduitM () ByteString (ResourceT IO) ())
res forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadThrow m =>
ParseSettings -> ConduitT ByteString o m Document
XML.sinkDoc forall a. Default a => a
XML.def
let cursor :: Cursor
cursor = Document -> Cursor
Cu.fromDocument Document
doc
let Response m
metadata Either SomeException a
x = Cursor -> Response m a
parse Cursor
cursor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall m. Monoid m => IORef m -> m -> IO ()
tellMetadataRef IORef m
metadataRef m
metadata
case Either SomeException a
x of
Left SomeException
err -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
err
Right a
v -> forall (m :: * -> *) a. Monad m => a -> m a
return a
v