hasql-url (empty) → 0.1.0.0

raw patch · 6 files changed

+225/−0 lines, 6 filesdep +basedep +bytestringdep +hasql

Dependencies added: base, bytestring, hasql, hasql-url, network-uri, split, tasty, tasty-quickcheck

Files

CHANGELOG.md +15/−0
LICENSE +21/−0
README.md +8/−0
hasql-url.cabal +78/−0
src/Hasql/URL.hs +78/−0
test/Spec.hs +25/−0

+ CHANGELOG.md view

@@ -0,0 +1,15 @@+# Changelog++`hasql-url` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++## 0.1.0.0++- Initial release++## 0.0.0.0++- Initially created.++[1]: https://pvp.haskell.org+[2]: https://github.com/shinzui/hasql-url/releases

+ LICENSE view

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2020 Nadeem Bitar++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ README.md view

@@ -0,0 +1,8 @@+# hasql-url++[![GitHub CI](https://github.com/shinzui/hasql-url/workflows/CI/badge.svg)](https://github.com/shinzui/hasql-url/actions)+[![Hackage](https://img.shields.io/hackage/v/hasql-url.svg?logo=haskell)](https://hackage.haskell.org/package/hasql-url)+[![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE)+++URL parser for [hasql](https://hackage.haskell.org/package/hasql). This package is a direct port of [postgresql-simple-url](https://hackage.haskell.org/package/postgresql-simple-url).

+ hasql-url.cabal view

@@ -0,0 +1,78 @@+cabal-version:   2.4+name:            hasql-url+version:         0.1.0.0+synopsis:+  Parse PostgreSQL connection URI into Hasql.Connection Settings++description:+  The 'Hasql.URL' module in this package exports+  a helper function 'parseDatabaseUrl' to+  construct 'Settings' from a URI (or string).+  .+  @+  >>> parseDatabaseUrl "postgres://username:password@localhost:5433/database"+  Just "host=localhost port=5433 user=username password=password dbname=database"+  @++homepage:        https://github.com/shinzui/hasql-url+bug-reports:     https://github.com/shinzui/hasql-url/issues+license:         MIT+license-file:    LICENSE+author:          Nadeem Bitar+maintainer:      Nadeem Bitar <nadeem@gmail.com>+copyright:       2020 Nadeem Bitar+category:        Utility+build-type:      Simple+extra-doc-files:+  CHANGELOG.md+  README.md++tested-with:     GHC ==8.10.2++source-repository head+  type:     git+  location: https://github.com/shinzui/hasql-url.git++common common-options+  build-depends:    base >=4.13 && <4.15+  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-uni-patterns+    -Wincomplete-record-updates++  if impl(ghc >=8.0)+    ghc-options: -Wredundant-constraints++  if impl(ghc >=8.2)+    ghc-options: -fhide-source-paths++  if impl(ghc >=8.4)+    ghc-options: -Wmissing-export-lists -Wpartial-fields++  if impl(ghc >=8.8)+    ghc-options: -Wmissing-deriving-strategies++  default-language: Haskell2010++library+  import:          common-options+  build-depends:+    , bytestring   ^>=0.10+    , hasql        ^>=1.4.4+    , network-uri  ^>=2.6.3+    , split        ^>=0.2.3++  hs-source-dirs:  src+  exposed-modules: Hasql.URL++test-suite hasql-url-test+  import:         common-options+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        Spec.hs+  build-depends:+    , hasql             ^>=1.4.4+    , hasql-url+    , tasty             ^>=1.4+    , tasty-quickcheck  ^>=0.10++  ghc-options:    -threaded -rtsopts -with-rtsopts=-N

+ src/Hasql/URL.hs view

@@ -0,0 +1,78 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : Hasql.URL+-- Description : Parses a postgresql connection string into a Hasql Settings+-- License     : MIT+--+-- Maintainer  : Nadeem Bitar <nadeem@gmail.com>+--+--+-- This is a direct port of [postgresql-simple-url](https://hackage.haskell.org/package/postgresql-simple-url) to Hasql.+module Hasql.URL+  ( parseDatabaseUrl,+  )+where++import Data.ByteString (ByteString)+import Data.ByteString.Char8 (pack)+import Data.List.Split+import Data.Word (Word16)+import Hasql.Connection (Settings, settings)+import Network.URI++data ConnectionInfo = ConnectionInfo+  { _port :: Word16,+    _username :: ByteString,+    _host :: ByteString,+    _password :: ByteString,+    _database :: ByteString+  }+  deriving stock (Show)++defaultConnectionInfo :: ConnectionInfo+defaultConnectionInfo = ConnectionInfo 5432 "postgres" "" "" ""++-- | Parse a string postgresql url into `Hasql.Connection.Settings`+--+-- @+-- parseDatabaseUrl \"postgres://username:password@domain.com:5433/database\" ==+-- Just $ settings \"domain.com\" (fromInteger 5433) \"username\" \"password\" \"database\"+-- @+parseDatabaseUrl :: String -> Maybe Settings+parseDatabaseUrl databaseUrl = parseURI databaseUrl >>= uriToSettings++uriToSettings :: URI -> Maybe Settings+uriToSettings uri+  | uriScheme uri /= "postgres:" && uriScheme uri /= "postgresql:" = Nothing+  | otherwise = mkSettingsFromConnectionInfo . ($ defaultConnectionInfo) <$> mkConnectionInfo uri++mkSettingsFromConnectionInfo :: ConnectionInfo -> Settings+mkSettingsFromConnectionInfo u = settings (_host u) (_port u) (_username u) (_password u) (_database u)++dropLast :: [a] -> [a]+dropLast [] = []+dropLast l = init l++mkConnectionInfo :: URI -> Maybe (ConnectionInfo -> ConnectionInfo)+mkConnectionInfo uri = case uriPath uri of+  ('/' : rest) | not (null rest) -> Just $ uriParameters uri+  _ -> Nothing++uriParameters :: URI -> (ConnectionInfo -> ConnectionInfo)+uriParameters uri = (\info -> info {_database = pack . tail $ uriPath uri}) . maybe id uriAuthParameters (uriAuthority uri)++uriAuthParameters :: URIAuth -> (ConnectionInfo -> ConnectionInfo)+uriAuthParameters uriAuth = port . host . auth+  where+    port = case uriPort uriAuth of+      (':' : p) -> \i -> i {_port = read p}+      _ -> id+    host = case uriRegName uriAuth of+      h -> \i -> i {_host = pack h}+    auth = case splitOn ":" (uriUserInfo uriAuth) of+      [""] -> id+      [u] -> \i -> i {_username = pack $ dropLast u}+      [u, p] -> \i -> i {_username = pack u, _password = pack $ dropLast p}+      _ -> id

+ test/Spec.hs view

@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}++import Hasql.Connection (Settings, settings)+import Hasql.URL+import Test.Tasty+import Test.Tasty.QuickCheck as QC++main :: IO ()+main = defaultMain caseProps++cases :: [(String, Maybe Settings)]+cases =+  [ ("postgres://username:password@domain.com:5433/database", Just $ settings "domain.com" 5433 "username" "password" "database"),+    ("postgresql://username:password@domain.com:5433/database", Just $ settings "domain.com" 5433 "username" "password" "database"),+    ("postgres://localhost:5432/database", Just $ settings "localhost" 5432 "postgres" "" "database"),+    ("postgres://username@localhost/database", Just $ settings "localhost" 5432 "username" "" "database"),+    ("postgres://localhost/database", Just $ settings "localhost" 5432 "postgres" "" "database"),+    ("postgres:///database", Just $ settings "" 5432 "postgres" "" "database"),+    ("postgres://", Nothing)+  ]++caseProps :: TestTree+caseProps = testGroup "Run test cases" $ map f cases+  where+    f (url, expected) = QC.testProperty url $ once $ property $ expected == parseDatabaseUrl url