Permalink
Browse files

add simple logging framework (fixes #13)

  • Loading branch information...
1 parent 16b72f9 commit 3d6da7e3ea400529f8dbb607869e64454dfcb669 @aristidb aristidb committed Jan 17, 2012
Showing with 25 additions and 15 deletions.
  1. +0 −2 Aws.hs
  2. +25 −7 Aws/Aws.hs
  3. +0 −5 Aws/Debug.hs
  4. +0 −1 aws.cabal
View
@@ -2,7 +2,6 @@ module Aws
(
module Aws.Aws
, module Aws.Credentials
-, module Aws.Debug
, module Aws.Http
, module Aws.Query
, module Aws.Response
@@ -15,7 +14,6 @@ where
import Aws.Aws
import Aws.Credentials
-import Aws.Debug
import Aws.Http
import Aws.Query
import Aws.Response
View
@@ -1,28 +1,36 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
module Aws.Aws
where
import Aws.Credentials
-import Aws.Debug
import Aws.Http
import Aws.Query
import Aws.Response
import Aws.S3.Info
+import Aws.Ses.Info
import Aws.Signature
import Aws.SimpleDb.Info
import Aws.Sqs.Info
-import Aws.Ses.Info
import Aws.Transaction
import Control.Applicative
+import Control.Monad.Trans (liftIO)
import Data.Attempt (attemptIO)
import Data.Conduit (runResourceT)
-import Control.Monad.Trans (liftIO)
import Data.IORef
import Data.Monoid
+import System.IO (stderr)
import qualified Control.Exception as E
import qualified Data.ByteString as B
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
import qualified Network.HTTP.Conduit as HTTP
+data LogLevel
+ = Debug
+ | Warning
+ | Error
+ deriving (Show, Eq, Ord)
+
data Configuration
= Configuration {
timeInfo :: TimeInfo
@@ -35,8 +43,13 @@ data Configuration
, sqsInfoUri :: SqsInfo
, sesInfo :: SesInfo
, sesInfoUri :: SesInfo
+ , logger :: LogLevel -> T.Text -> IO ()
}
+defaultLog :: LogLevel -> LogLevel -> T.Text -> IO ()
+defaultLog minLevel lev t | lev >= minLevel = T.hPutStrLn stderr $ T.concat [T.pack $ show lev, ": ", t]
+ | otherwise = return ()
+
class ConfigurationFetch a where
configurationFetch :: Configuration -> a
configurationFetchUri :: Configuration -> a
@@ -75,13 +88,18 @@ baseConfiguration = do
, sqsInfoUri = sqs HTTP sqsEndpointUsClassic True
, sesInfo = sesHttpsPost sesUsEast
, sesInfoUri = sesHttpsGet sesUsEast
+ , logger = defaultLog Warning
}
-- TODO: better error handling when credentials cannot be loaded
debugConfiguration :: IO Configuration
debugConfiguration = do
c <- baseConfiguration
- return c { sdbInfo = sdbHttpPost sdbUsEast, sdbInfoUri = sdbHttpGet sdbUsEast }
+ return c {
+ sdbInfo = sdbHttpPost sdbUsEast
+ , sdbInfoUri = sdbHttpGet sdbUsEast
+ , logger = defaultLog Debug
+ }
aws :: (Transaction r a
, ConfigurationFetch (Info r))
@@ -103,7 +121,7 @@ unsafeAws cfg manager request = do
sd <- signatureData <$> timeInfo <*> credentials $ cfg
let info = configurationFetch cfg
let q = signQuery request info sd
- debugPrint "String to sign" $ sqStringToSign q
+ logger cfg Debug $ T.pack $ "String to sign: " ++ show (sqStringToSign q)
let httpRequest = queryToHttpRequest q
metadataRef <- newIORef mempty
resp <- attemptIO (id :: E.SomeException -> E.SomeException) $
@@ -122,6 +140,6 @@ awsUri cfg request = do
info = configurationFetchUri cfg
sd <- signatureData ti cr
let q = signQuery request info sd
- debugPrint "String to sign" $ sqStringToSign q
+ logger cfg Debug $ T.pack $ "String to sign: " ++ show (sqStringToSign q)
return $ queryToUri q
View
@@ -1,5 +0,0 @@
-module Aws.Debug
-where
-
-debugPrint :: (Show a) => String -> a -> IO ()
-debugPrint p v = putStrLn $ "AWS Debug: " ++ p ++ " - " ++ show v
View
@@ -51,7 +51,6 @@ Library
Aws,
Aws.Aws,
Aws.Credentials,
- Aws.Debug,
Aws.Http,
Aws.Query,
Aws.Response,

0 comments on commit 3d6da7e

Please sign in to comment.