pg-harness-server 0.5.0 → 0.5.1

raw patch · 4 files changed

+44/−20 lines, 4 filesdep +warp

Dependencies added: warp

Files

• data/pg-harness.ini +1/−0
• pg-harness-server.cabal +2/−1
• src/Main.hs +37/−18
• src/PgHarness/Configuration.hs +4/−1

@@ -1,5 +1,6 @@ [rest] listenPort=8900+listenHost=*  [postgresql] # User/password combination which the daemon will use to create/drop databases

@@ -1,5 +1,5 @@ Name:                pg-harness-server-Version:             0.5.0+Version:             0.5.1 Synopsis:            REST service for creating temporary PostgreSQL databases Description:   REST service for conveniently creating temporary PostgreSQL databases@@ -34,6 +34,7 @@                    , scotty >= 0.11.0 && < 0.12                    , text >= 1.1.0 && < 2                    , transformers >= 0.5 && < 0.6+                   , warp >= 3.2 && < 3.3   Hs-source-dirs:    src   Default-language:  Haskell2010   Other-modules:     Paths_pg_harness_server

@@ -25,14 +25,15 @@ import           Control.Concurrent.Async (async, withAsync, waitCatch) import           Control.Exception (bracket) import           Control.Monad (void)-import           Control.Monad.IO.Class (liftIO)+import           Control.Monad.IO.Class (MonadIO, liftIO) import           Data.String (fromString) import qualified Data.Text.Lazy as TL import           Database.PostgreSQL.Simple (Connection, ConnectInfo(..), Only(..)) import qualified Database.PostgreSQL.Simple as P+import           Network.Wai.Handler.Warp (setPort, setHost, defaultSettings) import           System.IO (stderr, hPutStrLn) import           System.Random (randomRIO)-import           Web.Scotty (ScottyM, scotty, post, text, raise)+import           Web.Scotty (ScottyM, Options(..), scottyOpts, post, text) import           Paths_pg_harness_server (getDataFileName) import           PgHarness.Mutex import           PgHarness.Configuration@@ -127,26 +128,32 @@      sqlDatabaseId = sqlIdentifier databaseId +-- Handle a create request, returns the database ID.+handleCreateRequest :: MonadIO m => Configuration -> Mutex -> m DatabaseId+handleCreateRequest configuration mutex = do+  -- Generate a name for temporary database.+  liftIO mkTemporaryDatabaseId >>= \case+    Left err ->+      error err -- We're generating the name ourselves, so no error+                -- handling needed.+    Right databaseId -> do+      -- Create the temporary database.+      liftIO $ withMutex mutex $ createTemporaryDatabase configuration databaseId+      return databaseId+ -- REST interface routes :: Configuration -> Mutex -> ScottyM () routes configuration@Configuration{..} mutex = do   -- Add all the routes.   post "/" $ do-    -- Generate a name for temporary database.-    liftIO mkTemporaryDatabaseId >>= \case-      Left err ->-        raise $ TL.pack err-      Right databaseId -> do-        -- Create the temporary database.-        liftIO $ withMutex mutex $ createTemporaryDatabase configuration databaseId-        -- Return a string with the username/password and database name.-        text $ TL.unlines-          [ TL.pack $ cfgTestUser-          , TL.pack $ cfgTestPassword-          , TL.pack $ cfgHost-          , TL.pack $ show $ cfgPort-          , TL.pack $ unquotedIdentifier databaseId-          ]+    databaseId <- handleCreateRequest configuration mutex+    text $ TL.unlines+      [ TL.pack $ cfgTestUser+      , TL.pack $ cfgTestPassword+      , TL.pack $ cfgHost+      , TL.pack $ show $ cfgPort+      , TL.pack $ unquotedIdentifier databaseId+      ]  main :: IO () main = do@@ -154,10 +161,22 @@   getDataFileName "pg-harness.ini" >>= loadConfiguration >>= \case     Left msg -> hPutStrLn stderr msg     Right configuration -> do+      -- Build options for Warp.+      let warpSettings =+            setPort (cfgListenPort configuration) $+            setHost (fromString $ cfgListenHost configuration) $+            defaultSettings+          options = Options { verbose = 1+                            , settings = warpSettings+                            }       -- Mutex to prevent multiple "create" requests from being       -- processed simultaneously; PostgreSQL cannot handle       -- "cloning" a template concurrently.       mutex <- mkMutex+      -- Force immediate creation of a single temporary database; we+      -- do this so that any configuration issues will become obvious+      -- on startup.+      void $ handleCreateRequest configuration mutex       -- Start the web serving thread       putStrLn $ "Starting with configuration: " ++ show configuration-      scotty (cfgListenPort configuration) $ routes configuration mutex+      scottyOpts options $ routes configuration mutex

@@ -30,7 +30,8 @@  -- Configuration for the application data Configuration = Configuration-    { cfgListenPort :: Int               -- Port to listen to for REST POST requests+    { cfgListenPort :: Int               -- Port to listen to for requests+    , cfgListenHost :: String            -- Host/interface to listen to for requests     , cfgUser :: String                  -- Administrator user's user name     , cfgPassword :: String              -- Administrator user's password     , cfgHost :: String                  -- PostgreSQL host@@ -48,6 +49,7 @@     Left err -> return $ Left err     Right ini -> return $ do       listenPort       <- readValue      rest       "listenPort" decimal ini+      listenHost       <- lookupValue    rest       "listenHost" ini       user             <- lookupValue    postgresql "user" ini       password         <- lookupValue    postgresql "password" ini       database         <- lookupDatabase postgresql "database" ini@@ -59,6 +61,7 @@       durationSeconds  <- readValue      postgresql "durationSeconds" decimal ini       return $ Configuration              { cfgListenPort = listenPort+             , cfgListenHost = T.unpack listenHost              , cfgUser = T.unpack user              , cfgPassword = T.unpack password              , cfgDatabase = database