HTTPS only

dbapi.cabal

@@ -16,6 +16,7 @@ executable dbapi
   build-depends:       base >=4.6 && <5
                      , HDBC, HDBC-postgresql
                      , warp, wai >= 3.0.1 && < 3.0.2
+                     , wai-extra
                      , HTTP, convertible
                      , case-insensitive
                      , http-types, scientific, time
@@ -28,6 +29,7 @@ executable dbapi
                      , http-media, regex-tdfa
                      , Ranged-sets
                      , transformers
+                     , warp-tls
                      , bcrypt
   Other-Modules:       Dbapi
                      , PgStructure
@@ -58,4 +60,5 @@ Test-Suite spec
                      , http-media, regex-tdfa
                      , Ranged-sets
                      , transformers
+                     , warp-tls
                      , bcrypt

src/Dbapi.hs

@@ -45,7 +45,10 @@ import Data.Ranged.Ranges (emptyRange)
 
 data AppConfig = AppConfig {
     configDbUri :: String
-  , configPort  :: Int }
+  , configPort  :: Int
+  , configSslCert :: FilePath
+  , configSslKey  :: FilePath
+  }
 
 jsonContentType :: (HeaderName, BS.ByteString)
 jsonContentType = (hContentType, "application/json")

src/Main.hs

@@ -9,6 +9,7 @@ import Database.HDBC.PostgreSQL (connectPostgreSQL')
 
 import Control.Applicative
 import Options.Applicative hiding (columns)
+import Network.Wai.Handler.WarpTLS (tlsSettings, runTLS)
 
 -- }}}
 
@@ -18,6 +19,10 @@ argParser = AppConfig
     <> help "database uri to expose, e.g. postgres://user:pass@host:port/database")
   <*> option (long "port" <> short 'p' <> metavar "NUMBER" <> value 3000
     <> help "port number on which to run HTTP server")
+  <*> strOption (long "sslcert" <> short 'c' <> metavar "PATH" <> value "test/test.crt"
+    <> help "path to SSL cert file")
+  <*> strOption (long "sslkey" <> short 'k' <> metavar "PATH" <> value "test/test.key"
+    <> help "path to SSL key file")
 
 main :: IO ()
 main = do
@@ -25,9 +30,12 @@ main = do
   let port = configPort conf
   let dburi = configDbUri conf
 
+  let tls = tlsSettings (configSslCert conf) (configSslKey conf)
+  let settings = setPort port defaultSettings
+
   Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String)
   conn <- connectPostgreSQL' dburi
-  run port $ app conn
+  runTLS tls settings $ app conn
 
   where
     describe = progDesc "create a REST API to an existing Postgres database"

test/SpecHelper.hs

@@ -18,7 +18,7 @@ import qualified Data.ByteString.Char8 as BS
 import Dbapi (app, AppConfig(..))
 
 cfg :: AppConfig
-cfg = AppConfig "postgres://postgres:@localhost:5432/dbapi_test" 9000
+cfg = AppConfig "postgres://postgres:@localhost:5432/dbapi_test" 9000 "test/test.crt" "test/test.key"
 
 openConnection :: IO Connection
 openConnection = connectPostgreSQL' $ configDbUri cfg

test/test.crt

@@ -0,0 +1,20 @@
+-----BEGIN CERTIFICATE-----
+MIIDRDCCAiwCCQD/S2JyvJS0tjANBgkqhkiG9w0BAQUFADBkMQswCQYDVQQGEwJV
+UzETMBEGA1UECBMKQ2FsaWZvcm5pYTEWMBQGA1UEBxMNU2FuIEZyYW5jaXNjbzET
+MBEGA1UEChMKTG9vcCBSZWN1cjETMBEGA1UEAxMKSm9lIE5lbHNvbjAeFw0xNDA5
+MjkxODU2MTFaFw0xNTA5MjkxODU2MTFaMGQxCzAJBgNVBAYTAlVTMRMwEQYDVQQI
+EwpDYWxpZm9ybmlhMRYwFAYDVQQHEw1TYW4gRnJhbmNpc2NvMRMwEQYDVQQKEwpM
+b29wIFJlY3VyMRMwEQYDVQQDEwpKb2UgTmVsc29uMIIBIjANBgkqhkiG9w0BAQEF
+AAOCAQ8AMIIBCgKCAQEAveoymmQBbtw9CqgWRIuV4YSxqRqitew6EmGdBcrz5hii
+n78KwpB6c3U5pQknTh+eVDiifB3CBghC9ns5XiCMseXbaKaliJFo6BTyAWglkk12
+ckbqodzceBqeCiRDZnHXgA17fTnxS8igw2Ov1pv1aKdoW+FO9aSqCetKAm0xsDfz
+Mfq9XBNJ4eN/aBxJCFS4vO0HFoFtWAAFUF4/fGoAZv65rNkR74Z/y26gJ58FKq6i
+NaUnBgZgZ+5Odi9ZTv+yZdIP6Abl3iC85S7vCtcRNWlcphhC6pFv7sLvurzKd2In
+l2I/iwSHm+La5QVnkS182EMe+IAZYyIVWkP9LEHRHwIDAQABMA0GCSqGSIb3DQEB
+BQUAA4IBAQAPC/8nMuq5Gvd0Ds880jpm6NnSeU0AiRsgmIwmaawofVYOze0MT+Ix
+/i9rDxo8LxwptEZCYXO6DEZq8yjSVGGccM+VOcj7bfxh2UqAfP6j+6H836nOY7Bk
+FDs2Q1sazx+YmsxaBLyyOoBK+6qDqDm4B4Bo3cl8s4eZf2i0yC0sOuO0PYyreX7y
+jFk7ELS7uA8ch1fPqp0WPn8rYvYUZKSKa7Q2Qu0ai+bciAMLYQNkpYFwbfLLHXwN
+/EqLAYrsGGiYU+VNtjrsknF0rxQieUQhoomdia/g3NMBoXSALqJoOaETW3e2DLHQ
+usaxg3L90+kmZDjfDS4DTH4gCx5pL0L1
+-----END CERTIFICATE-----

test/test.key

@@ -0,0 +1,27 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIIEogIBAAKCAQEAveoymmQBbtw9CqgWRIuV4YSxqRqitew6EmGdBcrz5hiin78K
+wpB6c3U5pQknTh+eVDiifB3CBghC9ns5XiCMseXbaKaliJFo6BTyAWglkk12ckbq
+odzceBqeCiRDZnHXgA17fTnxS8igw2Ov1pv1aKdoW+FO9aSqCetKAm0xsDfzMfq9
+XBNJ4eN/aBxJCFS4vO0HFoFtWAAFUF4/fGoAZv65rNkR74Z/y26gJ58FKq6iNaUn
+BgZgZ+5Odi9ZTv+yZdIP6Abl3iC85S7vCtcRNWlcphhC6pFv7sLvurzKd2Inl2I/
+iwSHm+La5QVnkS182EMe+IAZYyIVWkP9LEHRHwIDAQABAoIBAGbG9qm9E1V2lQZO
+Xvarf+pzEF6Ozp2bgPXvo7W91u6gSGohTmZrIAmZ2B9ra70IuXukxrJavGTdVbfk
+ifBZtyqTVYE2JoFZCCgJJcsDHMonZ8GChXohd6L77KlaZKttUo23PixQDjjQE8iK
+C2AeONpxNrX6oeuoOGlzzzKu+2P8g/s3PZT0W3KjiRYYTJOeU4giPvYTrCsNiOTq
+ciaqT7XN/2tfE9xYvVTaHxFMtXRCKQ9u2yBTJ+QIGHuQaB2x0fwj4c98oQTY3ZqP
+nE58p5duG/8nWItLrOwusV9e7hxXPC/qf/vgLUmNfRd0ES4iCIjCRDISpiUsuMdt
+9i+W8cECgYEA7+4S6XLEZv/ADCxf4/ewAxcTyEt4mlRU5thrl2wONbNvyf/fiCxD
+u4NylnLFCb+5TIqgD886TTGj2qAs2q/pyDLDGeD7tsdAi77FI67nT7ady45RmsGr
+oe22M3klgYLsQbgrWOB2FVW6/Ii6wJ82zo6UICU6oAz3nQ2zHgL8sn8CgYEAyqKL
+zM612Qm+Xx6YGuwr8cq77NhXABtlZMwZjb8Q/TvOlwdvH+ERFJsU8p7NXBEXD9vU
+FXOZcHs+iCoMqOsE6V6iY3pvL3Q74PKx5UzB5kNXxdySWbIaRUZlSBFmzGC9/L6e
+zfau6zwf1mn38agxv3fWNgTJryBQQ3oR5VX4UWECgYBI4RUnii/0ZW0thXEfKwZw
++dqNdbdNkZ40fLq5xR3P3BBx2GJK178/Px9YacZGPtGHWXhjNPwtpI10BEF7sAGg
+SSMQQlHTZFTL3ge93gvvH7ZwtWs+SePbjPxSSFNHMsCW+d1Y4t2bf24L9XBcwEAC
+oDaISSa0pRu1vgqRbDDb+wKBgAeMIFrjhCBuXXnbgNzX2Rcrbu52bF8jphYoB/eg
+mzhjZuF3NGtijalP0WrsAUghltNPY8ncwWVQIdcegdQ01L0AelnsMIH6+VP6liet
+QTebYISNH6JZoOLdqV4Sz9pi7BCi5PVU79TxK1poHgURN7Ei/IaMjRqJwJOS02HQ
+XuxhAoGAZ89zIqlWUkl1jTvUEUMUljiZpCvM3oCWfnGHoLlg5b6G5AESUCTeNVWg
+M3G7KBWJ8LzjezX1SUBP8gr1TZYlT15BXmpYAOrTGPBvsi8ajtvXWK+RO40ywAbp
+zsSgwB4J8gaggb6z6XqbQhMeuNmhzKV4hHXy2Eu08ApgXuPIp7M=
+-----END RSA PRIVATE KEY-----