From 6260c7dbecc2bf4ed3673a087f566f9bfc135a32 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Fri, 29 Apr 2011 11:08:08 -0700 Subject: [PATCH] Add basic documentation. --- Database/MySQL/Simple.hs | 22 ++++++++++++ Database/MySQL/Simple/Orphans.hs | 11 ++++++ Database/MySQL/Simple/Param.hs | 38 ++++++++++++++++++--- Database/MySQL/Simple/QueryParams.hs | 14 ++++++++ Database/MySQL/Simple/QueryResults.hs | 16 +++++++++ Database/MySQL/Simple/Result.hs | 34 +++++++++++++++---- Database/MySQL/Simple/Types.hs | 49 ++++++++++++++++++++++++--- 7 files changed, 169 insertions(+), 15 deletions(-) diff --git a/Database/MySQL/Simple.hs b/Database/MySQL/Simple.hs index 3003809..809e3e4 100644 --- a/Database/MySQL/Simple.hs +++ b/Database/MySQL/Simple.hs @@ -1,10 +1,23 @@ {-# LANGUAGE DeriveDataTypeable #-} +-- | +-- Module: Database.MySQL.Simple +-- Copyright: (c) 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Bryan O'Sullivan +-- Stability: experimental +-- Portability: portable +-- +-- A mid-level client library for the MySQL database, aimed at ease of +-- use and high performance. + module Database.MySQL.Simple ( FormatError(fmtMessage, fmtQuery, fmtParams) , Only(..) + , Query , execute + , execute_ , query , query_ , formatQuery @@ -53,6 +66,15 @@ formatQuery conn q@(Query template) qs execute :: (QueryParams q) => Connection -> Query -> q -> IO Int64 execute conn template qs = do Base.query conn =<< formatQuery conn template qs + finishExecute conn + +execute_ :: Connection -> Query -> IO Int64 +execute_ conn (Query stmt) = do + Base.query conn stmt + finishExecute conn + +finishExecute :: Connection -> IO Int64 +finishExecute conn = do ncols <- Base.fieldCount (Left conn) if ncols /= 0 then error "execute: executed a select!" diff --git a/Database/MySQL/Simple/Orphans.hs b/Database/MySQL/Simple/Orphans.hs index 1a88f0b..daff1ba 100644 --- a/Database/MySQL/Simple/Orphans.hs +++ b/Database/MySQL/Simple/Orphans.hs @@ -1,6 +1,17 @@ {-# LANGUAGE BangPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +-- | +-- Module: Database.MySQL.Orphans +-- Copyright: (c) 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Bryan O'Sullivan +-- Stability: experimental +-- Portability: portable +-- +-- Orphan instances of frequently used typeclasses for types that +-- really should have them. + module Database.MySQL.Simple.Orphans () where import Control.DeepSeq (NFData(..)) diff --git a/Database/MySQL/Simple/Param.hs b/Database/MySQL/Simple/Param.hs index 6a06c49..9f3b187 100644 --- a/Database/MySQL/Simple/Param.hs +++ b/Database/MySQL/Simple/Param.hs @@ -1,4 +1,14 @@ -{-# LANGUAGE FlexibleInstances, OverloadedStrings #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, OverloadedStrings #-} + +-- | +-- Module: Database.MySQL.Simple.Param +-- Copyright: (c) 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Bryan O'Sullivan +-- Stability: experimental +-- Portability: portable +-- +-- The 'Param' typeclass, for rendering a parameter to a SQL query. module Database.MySQL.Simple.Param ( @@ -16,6 +26,7 @@ import Data.Time.Calendar (Day, showGregorian) import Data.Time.Clock (UTCTime) import Data.Time.Format (formatTime) import Data.Time.LocalTime (TimeOfDay) +import Data.Typeable (Typeable) import Data.Word (Word, Word8, Word16, Word32, Word64) import Database.MySQL.Simple.Types (Null) import System.Locale (defaultTimeLocale) @@ -26,11 +37,27 @@ import qualified Data.Text as ST import qualified Data.Text.Encoding as ST import qualified Data.Text.Lazy as LT -data Action = Plain Builder - | Escape ByteString - +-- | How to render an element when substituting it into a query. +data Action = + Plain Builder + -- ^ Render without escaping or quoting. Use for non-text types + -- such as numbers, when you are /certain/ that they will not + -- introduce formatting vulnerabilities via use of characters such + -- as spaces or \"@'@\". + | Escape ByteString + -- ^ Escape and enclose in quotes before substituting. Use for all + -- text-like types, and anything else that may contain unsafe + -- characters when rendered. + deriving (Typeable) + +instance Show Action where + show (Plain b) = "Plain " ++ show (toByteString b) + show (Escape b) = "Escape " ++ show b + +-- | A type that may be used as a single parameter to a SQL query. class Param a where render :: a -> Action + -- ^ Prepare a value for substitution into a query string. instance Param Action where render a = a @@ -138,6 +165,9 @@ instance Param TimeOfDay where render = Plain . inQuotes . Utf8.fromString . show {-# INLINE render #-} +-- | Surround a string with single-quote characters: \"@'@\" +-- +-- This function /does not/ perform any other escaping. inQuotes :: Builder -> Builder inQuotes b = quote `mappend` b `mappend` quote where quote = Utf8.fromChar '\'' diff --git a/Database/MySQL/Simple/QueryParams.hs b/Database/MySQL/Simple/QueryParams.hs index 7f0f142..e86e8ef 100644 --- a/Database/MySQL/Simple/QueryParams.hs +++ b/Database/MySQL/Simple/QueryParams.hs @@ -1,3 +1,14 @@ +-- | +-- Module: Database.MySQL.Simple.QueryParams +-- Copyright: (c) 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Bryan O'Sullivan +-- Stability: experimental +-- Portability: portable +-- +-- The 'QueryParams' typeclass, for rendering a collection of +-- parameters to a SQL query. + module Database.MySQL.Simple.QueryParams ( QueryParams(..) @@ -6,8 +17,11 @@ module Database.MySQL.Simple.QueryParams import Database.MySQL.Simple.Param (Action(..), Param(..)) import Database.MySQL.Simple.Types (Only(..)) +-- | A collection type that can be turned into a list of rendering +-- 'Action's. class QueryParams a where renderParams :: a -> [Action] + -- ^ Render a collection of values. instance QueryParams () where renderParams _ = [] diff --git a/Database/MySQL/Simple/QueryResults.hs b/Database/MySQL/Simple/QueryResults.hs index 5c69589..10d7fdf 100644 --- a/Database/MySQL/Simple/QueryResults.hs +++ b/Database/MySQL/Simple/QueryResults.hs @@ -1,3 +1,14 @@ +-- | +-- Module: Database.MySQL.Simpe.QueryResults +-- Copyright: (c) 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Bryan O'Sullivan +-- Stability: experimental +-- Portability: portable +-- +-- The 'QueryResults' typeclass, for converting a row of results +-- returned by a SQL query into a more useful Haskell representation. + module Database.MySQL.Simple.QueryResults ( QueryResults(..) @@ -10,8 +21,13 @@ import Database.MySQL.Base.Types (Field) import Database.MySQL.Simple.Result (ResultError(..), Result(..)) import Database.MySQL.Simple.Types (Only(..)) +-- | A collection type that can be converted from a list of strings. class (NFData a) => QueryResults a where convertResults :: [Field] -> [Maybe ByteString] -> a + -- ^ Convert values from a row into a Haskell collection. + -- + -- This function will throw an exception if conversion of any + -- element of the collection fails. instance (NFData a, Result a) => QueryResults (Only a) where convertResults [fa] [va] = Only (convert fa va) diff --git a/Database/MySQL/Simple/Result.hs b/Database/MySQL/Simple/Result.hs index 6a7d886..cd39532 100644 --- a/Database/MySQL/Simple/Result.hs +++ b/Database/MySQL/Simple/Result.hs @@ -1,5 +1,16 @@ {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances #-} +-- | +-- Module: Database.MySQL.Simpe.QueryResults +-- Copyright: (c) 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Bryan O'Sullivan +-- Stability: experimental +-- Portability: portable +-- +-- The 'Result' typeclass, for converting a single value in a row +-- returned by a SQL query into a more useful Haskell representation. + module Database.MySQL.Simple.Result ( Result(..) @@ -33,21 +44,32 @@ import qualified Data.Text as ST import qualified Data.Text.Encoding as ST import qualified Data.Text.Lazy as LT -data ResultError = Incompatible { errSourceType :: String - , errDestType :: String +-- | This exception is thrown if conversion from a SQL value to a +-- Haskell value fails. +data ResultError = Incompatible { errSQLType :: String + , errHaskellType :: String , errMessage :: String } - | UnexpectedNull { errSourceType :: String - , errDestType :: String + -- ^ The SQL and Haskell types are not compatible. + | UnexpectedNull { errSQLType :: String + , errHaskellType :: String , errMessage :: String } - | ConversionFailed { errSourceType :: String - , errDestType :: String + -- ^ A SQL @NULL@ was encountered when the Haskell + -- type did not permit it. + | ConversionFailed { errSQLType :: String + , errHaskellType :: String , errMessage :: String } + -- ^ The SQL value could not be parsed, or could not + -- be represented as a valid Haskell value. deriving (Eq, Show, Typeable) instance Exception ResultError +-- | A type that may be converted from a SQL type. class (NFData a) => Result a where convert :: Field -> Maybe ByteString -> a + -- ^ Convert a SQL value to a Haskell value. + -- + -- Throws a 'ResultError' if conversion fails. instance (Result a) => Result (Maybe a) where convert _ Nothing = Nothing diff --git a/Database/MySQL/Simple/Types.hs b/Database/MySQL/Simple/Types.hs index bd7a732..06b793c 100644 --- a/Database/MySQL/Simple/Types.hs +++ b/Database/MySQL/Simple/Types.hs @@ -1,4 +1,14 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-} + +-- | +-- Module: Database.MySQL.Simple.Types +-- Copyright: (c) 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Bryan O'Sullivan +-- Stability: experimental +-- Portability: portable +-- +-- Basic types. module Database.MySQL.Simple.Types ( @@ -7,18 +17,39 @@ module Database.MySQL.Simple.Types , Query(..) ) where +import Blaze.ByteString.Builder import Control.Arrow import Control.DeepSeq (NFData) -import Blaze.ByteString.Builder +import Data.ByteString (ByteString) import Data.String (IsString(..)) +import Data.Typeable (Typeable) import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8 -import Data.ByteString (ByteString) data Null = Null + deriving (Read, Show, Typeable) + +instance Eq Null where + _ == _ = False + _ /= _ = False +-- | A query string. This type is intended to make it difficult to +-- construct a SQL query by concatenating string fragments, as that is +-- an extremely common way to accidentally introduce SQL injection +-- vulnerabilities into an application. +-- +-- This type is an instance of 'IsString', so the easiest way to +-- construct a query is to enable the @OverloadedStrings@ language +-- extension and then simply write the query in double quotes. +-- +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Database.MySQL.Simple +-- > +-- > q :: Query +-- > q = "select ?" newtype Query = Query { fromQuery :: ByteString - } deriving (Eq, Ord) + } deriving (Eq, Ord, Typeable) instance Show Query where show = show . fromQuery @@ -29,5 +60,13 @@ instance Read Query where instance IsString Query where fromString = Query . toByteString . Utf8.fromString +-- | A single-value collection. +-- +-- This can be handy if you need to supply a single parameter to a SQL +-- query. +-- +-- Example: +-- +-- @query \"select x from scores where x > ?\" ('Only' (42::Int))@ newtype Only a = Only a - deriving (Eq, Ord, Read, Show, NFData) + deriving (Eq, Ord, Read, Show, NFData, Typeable, Functor)