Internal.hs

module Web.Heroku.Internal ( 
    dbConnParams' 
  , parseDatabaseUrl'
  ) where

import System.Environment
import Network.URI
import Data.Text
import Prelude

-- | read the DATABASE_URL environment variable
-- and return an alist of connection parameters with the following keys:
-- user, password, host, port, dbname
--
-- warning: just calls error if it can't parse correctly
dbConnParams' :: String -> (String -> [(Text, Text)]) -> IO [(Text, Text)]
dbConnParams' envVar parse = getEnv envVar >>= return . parse

parseDatabaseUrl' :: String -> String -> [(Text, Text)]
parseDatabaseUrl' scheme durl =
  let muri = parseAbsoluteURI durl
      (auth, path) = case muri of
                      Nothing ->  error "couldn't parse absolute uri"
                      Just uri -> if uriScheme uri /= scheme
                                    then schemeError uri
                                    else case uriAuthority uri of
                                           Nothing   -> invalid
                                           Just a -> (a, uriPath uri)
      (user,password) = userAndPassword auth
  in     [ (pack "user",     user)
           -- tail not safe, but should be there on Heroku
         , (pack "password", Data.Text.tail password)
         , (pack "host",     pack $ uriRegName auth)
         , (pack "port",     pack $ removeColon $ uriPort auth)
         -- tail not safe but path should always be there
         , (pack "dbname",   pack $ Prelude.tail $ path)
         ]
  where
    removeColon (':':port) = port
    removeColon port = port

    -- init is not safe, but should be there on Heroku
    userAndPassword :: URIAuth -> (Text, Text)
    userAndPassword = (breakOn $ pack ":") . pack . Prelude.init . uriUserInfo

    schemeError uri = error $ "was expecting a postgres scheme, not: " ++ (uriScheme uri) ++ "\n" ++ (show uri)
    -- should be an error 
    invalid = error "could not parse heroku DATABASE_URL"