diff --git a/MIT-LICENSE.txt b/MIT-LICENSE.txt
new file mode 100644
--- /dev/null
+++ b/MIT-LICENSE.txt
@@ -0,0 +1,20 @@
+The MIT License (MIT)
+Copyright (c) 2015 Ian Grant Jeffries
+
+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.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,32 @@
+# Intro
+
+An implementation of [JSON Schema](http://json-schema.org/) v4 in haskell.
+
+# Status
+
+Still in development. Lacks documentation, example code, and real error messages.
+
+Also while all the official tests pass, its implementation of the `$ref` and `id` keywords is incomplete.
+
+# Install Tests
+
+    git submodule update --init
+
+# Run Tests
+
+    cd JSON-Schema-Test-Suite/remotes
+    python -m SimpleHTTPServer 1234
+
+Then run the normal `cabal test` from another terminal.
+
+Note that the tests require an internet connection.
+
+# Notes
+
+This uses the [regexpr](https://hackage.haskell.org/package/regexpr-0.5.4) regular expression library fo the "pattern" validator. I have no idea if this is compatible with the ECMA 262 regex dialect, which the [spec](http://json-schema.org/latest/json-schema-validation.html#anchor33) requires.
+
+# Credits
+
+Thanks to [Julian Berman](https://github.com/Julian) for the fantastic test suite.
+
+Also thanks to Tim Baumann for his [aeson-schema](https://hackage.haskell.org/package/aeson-schema) library. Hjsonschema is based on Aeson-Schema, and some code is directly from there.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/hjsonschema.cabal b/hjsonschema.cabal
new file mode 100644
--- /dev/null
+++ b/hjsonschema.cabal
@@ -0,0 +1,58 @@
+name:                   hjsonschema
+version:                0.1.0.0
+synopsis:               Haskell implementation of JSON Schema v4.
+homepage:               https://github.com/seagreen/hjsonschema
+license:                MIT
+license-file:           MIT-LICENSE.txt
+author:                 Ian Grant Jeffries
+maintainer:             ian@housejeffries.com
+category:               Data
+build-type:             Simple
+extra-source-files:     README.md
+cabal-version:          >=1.10
+
+library
+  hs-source-dirs:       src
+  exposed-modules:      Data.JsonSchema
+                      , Data.JsonSchema.JsonReference
+                      , Data.JsonSchema.Utils
+                      , Data.JsonSchema.Validators
+  other-modules:        Data.JsonSchema.Core
+  default-language:     Haskell2010
+  default-extensions:   OverloadedStrings
+  ghc-options:          -Wall
+  build-depends:        aeson                >= 0.8  && < 0.9
+                      , base                 >= 4.7  && < 4.8
+                      , bytestring           >= 0.10 && < 0.11
+                      , hashable             >= 1.2  && < 1.3
+                      , lens                 >= 4.7  && < 4.8
+                      , regexpr              >= 0.5  && < 0.6
+                      , scientific           >= 0.3  && < 0.4
+                      , unordered-containers >= 0.2  && < 0.3
+                      , text                 >= 1.2  && < 1.3
+                      , vector               >= 0.10 && < 0.11
+                      , wreq                 >= 0.3  && < 0.4
+
+test-suite official
+  type:                 exitcode-stdio-1.0
+  hs-source-dirs:       tests
+  main-is:              Test.hs
+  default-language:     Haskell2010
+  ghc-options:          -Wall
+  default-extensions:   OverloadedStrings
+  build-depends:        aeson
+                      , base
+                      , bytestring
+                      , hjsonschema
+                      , unordered-containers
+                      , text
+                      , vector
+                      , directory            >= 1.2 && < 1.3
+                      , filepath             >= 1.3 && < 1.4
+                      , HUnit                >= 1.2 && < 1.3
+                      , test-framework       >= 0.8 && < 0.9
+                      , test-framework-hunit >= 0.3 && < 0.4
+
+source-repository head
+  type:               git
+  location:           git://github.com/seagreen/hjsonschema.git
diff --git a/src/Data/JsonSchema.hs b/src/Data/JsonSchema.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/JsonSchema.hs
@@ -0,0 +1,80 @@
+module Data.JsonSchema
+  ( module Data.JsonSchema
+  , module Data.JsonSchema.Core
+  ) where
+
+import           Control.Applicative
+import           Data.Aeson
+import           Data.Foldable
+import qualified Data.HashMap.Strict           as H
+import           Data.JsonSchema.Core
+import           Data.JsonSchema.JsonReference
+import           Data.JsonSchema.Utils
+import           Data.JsonSchema.Validators
+import           Data.Maybe
+import           Data.Text                     (Text)
+import qualified Data.Text                     as T
+import           Data.Vector                   (Vector)
+import qualified Data.Vector                   as V
+import           Prelude                       hiding (foldr)
+
+draft4 :: Spec
+draft4 = Spec $ H.fromList
+  [ ("$ref", ref)
+  , ("multipleOf", multipleOf)
+  , ("maximum", maximumVal)
+  , ("minimum", minimumVal)
+  , ("maxLength", maxLength)
+  , ("minLength", minLength)
+  , ("pattern", pattern)
+  , ("items", items)
+  , ("maxItems", maxItems)
+  , ("minItems", minItems)
+  , ("uniqueItems", uniqueItems)
+  , ("maxProperties", maxProperties)
+  , ("minProperties", minProperties)
+  , ("required", required)
+  , ("properties", properties)
+  , ("patternProperties", patternProperties)
+  , ("additionalProperties", additionalProperties)
+  , ("dependencies", dependencies)
+  , ("enum", enum)
+  , ("type", typeVal)
+  , ("allOf", allOf)
+  , ("anyOf", anyOf)
+  , ("oneOf", oneOf)
+  , ("not", notValidator)
+  ]
+
+fetchRefs :: RawSchema -> Graph -> IO Graph
+fetchRefs a graph =
+  let newGraph = H.insert (_rsURI a) (_rsObject a) graph
+      rSchema = allEmbedded (_rsURI a, Object $ _rsObject a) V.empty
+  in foldlM fetch newGraph rSchema
+
+  where
+    -- TODO: optimize
+    allEmbedded :: (Text, Value) -> Vector RawSchema -> Vector RawSchema
+    allEmbedded (t, Object o) rs =
+      let t' = updateId t o
+          r = RawSchema t' o
+          ns = (\x -> (t',x)) <$> V.fromList (H.elems o)
+      in foldr allEmbedded (V.snoc rs r) ns
+    allEmbedded (t, Array vs) rs =
+      let ns = (\x -> (t,x)) <$> vs
+      in foldr allEmbedded rs ns
+    allEmbedded _ rs = rs
+
+    fetch :: Graph -> RawSchema -> IO Graph
+    fetch g r =
+      case H.lookup "$ref" (_rsObject r) >>= toTxt >>= refAndP of
+        Nothing     -> return g
+        Just (s, _) ->
+          let t = (_rsURI r `combineIdAndRef` s)
+          in if T.length t <= 0 || H.member t g || not ("://" `T.isInfixOf` t)
+            then return g
+            else do
+              eResp <- fetchRef t
+              case eResp of
+                Right obj -> fetchRefs (RawSchema t obj) g
+                _         -> return g
diff --git a/src/Data/JsonSchema/Core.hs b/src/Data/JsonSchema/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/JsonSchema/Core.hs
@@ -0,0 +1,38 @@
+module Data.JsonSchema.Core where
+
+import           Data.Aeson
+import           Data.HashMap.Strict           (HashMap)
+import qualified Data.HashMap.Strict           as H
+import           Data.JsonSchema.JsonReference
+import           Data.Maybe
+import           Data.Text                     (Text)
+import           Data.Vector                   (Vector)
+import qualified Data.Vector                   as V
+
+newtype Spec = Spec { _unSpec :: HashMap Text ValidatorGen }
+
+-- | Set of potentially mutually recursive schemas.
+type Graph = HashMap Text (HashMap Text Value)
+
+type ValErr = Text
+
+type Validator = Value -> Vector ValErr
+
+type ValidatorGen = Spec -> Graph -> RawSchema -> Value -> Maybe Validator
+
+type Schema = Vector Validator
+
+data RawSchema = RawSchema
+  { _rsURI    :: Text
+  , _rsObject :: HashMap Text Value
+  }
+
+compile :: Spec -> Graph -> RawSchema -> Schema
+compile spec g (RawSchema t o) =
+  V.fromList . catMaybes . H.elems $ H.intersectionWith f (_unSpec spec) o
+  where
+    f :: ValidatorGen -> Value -> Maybe Validator
+    f vGen = vGen spec g $ RawSchema (updateId t o) o
+
+validate :: Schema -> Value -> Vector ValErr
+validate s x = s >>= ($ x)
diff --git a/src/Data/JsonSchema/JsonReference.hs b/src/Data/JsonSchema/JsonReference.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/JsonSchema/JsonReference.hs
@@ -0,0 +1,92 @@
+module Data.JsonSchema.JsonReference where
+
+-- | There should be a JSON Reference library for haskell.
+
+import           Control.Exception
+import           Control.Lens
+import           Control.Monad
+import           Data.Aeson
+import           Data.ByteString.Lazy (ByteString)
+import           Data.HashMap.Strict  (HashMap)
+import qualified Data.HashMap.Strict  as H
+import           Data.Monoid
+import           Data.Text            (Text)
+import qualified Data.Text            as T
+import qualified Data.Vector          as V
+import           Network.Wreq
+import           Prelude              hiding (foldr)
+import           Text.Read            (readMaybe)
+
+combineIdAndRef :: Text -> Text -> Text
+combineIdAndRef a b
+  | "://" `T.isInfixOf` b              = b
+  | T.length a < 1 || T.length b < 1   = a <> b
+  | T.last a == '#' && T.head b == '#' = a <> T.tail b
+  | otherwise                          = a <> b
+
+combineIds :: Text -> Text -> Text
+combineIds a b
+  | b == "#" || b == ""                = a
+  | "://" `T.isInfixOf` b              = b
+  | T.length a < 1 || T.length b < 1   = a <> b
+  | T.last a == '#' && T.head b == '#' = a <> T.tail b
+  | otherwise                          = a <> b
+
+updateId :: Text -> HashMap Text Value -> Text
+updateId t o =
+  case H.lookup "id" o of
+    Just (String idVal) -> t `combineIds` idVal
+    _                   -> t
+
+refAndP :: Text -> Maybe (Text, Text)
+refAndP val = getParts $ T.splitOn "#" val
+  where
+    getParts :: [Text] -> Maybe (Text, Text)
+    getParts []    = Just ("","")
+    getParts [x]   = Just (x,"")
+    getParts [x,y] = Just (x,y)
+    getParts _     = Nothing
+
+fetchRef :: Text -> IO (Either Text (HashMap Text Value))
+fetchRef t = do
+  eResp <- safeGet t
+  case eResp of
+    Left _  -> return (Left "TODO")
+    Right b ->
+      case decode b of
+        Just (Object z) -> return (Right z)
+        _               -> return (Left "TODO")
+
+safeGet :: Text -> IO (Either Text ByteString)
+safeGet url =
+  catch
+    (return . Right . (^. responseBody) =<< get (T.unpack url))
+    handler
+  where
+    handler :: SomeException -> IO (Either Text ByteString)
+    handler e = return . Left . T.pack . show $ e
+
+-- | There should be a JSON Pointer library.
+--
+-- Spec: http://tools.ietf.org/html/draft-ietf-appsawg-json-pointer-07
+jsonPointer :: Text -> Value -> Maybe Value
+jsonPointer pntr = resolve (T.splitOn "/" pntr)
+  where
+    resolve :: [Text] -> Value -> Maybe Value
+    resolve (referenceToken:ts) a =
+      let t = unescape referenceToken
+      in case T.length t of
+        0 -> resolve ts a
+        _ ->
+          case a of
+            (Object b) -> H.lookup t b >>= resolve ts
+            (Array c)  -> do
+              n <- readMaybe (T.unpack t)
+              when (n < 0 || n + 1 > V.length c) Nothing
+              resolve ts (c V.! n)
+            _ -> Nothing
+    resolve _ a = Just a
+
+    -- TODO: do more things need to be escaped?
+    unescape :: Text -> Text
+    unescape t = T.replace "%25" "%" $ T.replace "~0" "~" $ T.replace "~1" "/" t
diff --git a/src/Data/JsonSchema/Utils.hs b/src/Data/JsonSchema/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/JsonSchema/Utils.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE OverloadedLists #-}
+
+module Data.JsonSchema.Utils where
+
+import           Data.Aeson
+import           Data.HashMap.Strict  (HashMap)
+import           Data.JsonSchema.Core
+import           Data.List
+import           Data.Monoid
+import           Data.Scientific
+import           Data.Text            (Text)
+import qualified Data.Text            as T
+import           Data.Vector          (Vector)
+import qualified Data.Vector          as V
+
+isJsonType :: Value -> Vector Text -> Vector ValErr
+isJsonType x xs =
+  case x of
+    (Null)     -> f "null"    xs ("null" :: Text)
+    (Array y)  -> f "array"   xs y
+    (Bool y)   -> f "boolean" xs y
+    (Object y) -> f "object"  xs y
+    (String y) -> f "string"  xs y
+    (Number y) ->
+      case toBoundedInteger y :: Maybe Int of
+        Nothing -> f "number" xs y
+        Just _  -> if V.elem "number" xs || V.elem "integer" xs
+                     then mempty
+                     else mkErr y xs
+  where
+    f :: (Show a) => Text -> Vector Text -> a -> Vector ValErr
+    f t ts d = if V.elem t ts then mempty else mkErr d ts
+
+    mkErr :: (Show a) => a -> Vector Text -> Vector ValErr
+    mkErr y ts = V.singleton $ tshow y <> " is not one of the types " <> tshow ts
+
+runMaybeVal :: Maybe Validator -> Value -> Vector ValErr
+runMaybeVal Nothing _ = mempty
+runMaybeVal (Just val) d = val d
+
+runMaybeVal'
+  :: Maybe (Value -> (Vector ValErr, Value))
+  -> Value
+  -> (Vector ValErr, Value)
+runMaybeVal' Nothing d = (mempty, d)
+runMaybeVal' (Just val) d = val d
+
+-- TODO: optimize
+-- see here: http://comments.gmane.org/gmane.comp.lang.haskell.cafe/106242
+allUnique :: (Eq a) => Vector a -> Bool
+allUnique bs = length (nub (V.toList bs)) == V.length bs
+
+-- TODO: optimize
+count :: (Eq a) => a -> Vector a -> Int
+count b bs = V.length $ V.filter (== b) bs
+
+toObj :: Value -> Maybe (HashMap Text Value)
+toObj (Object a) = Just a
+toObj _ = Nothing
+
+fromJSONInt :: Value -> Maybe Int
+fromJSONInt (Number n) = toBoundedInteger n
+fromJSONInt _ = Nothing
+
+toTxt :: Value -> Maybe Text
+toTxt (String t) = Just t
+toTxt _ = Nothing
+
+greaterThanZero :: (Num a, Ord a) => a -> Maybe ()
+greaterThanZero n = if n <= 0 then Nothing else Just ()
+
+tshow :: Show a => a -> Text
+tshow = T.pack . show
diff --git a/src/Data/JsonSchema/Validators.hs b/src/Data/JsonSchema/Validators.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/JsonSchema/Validators.hs
@@ -0,0 +1,497 @@
+{-# LANGUAGE OverloadedLists #-}
+
+-- | This is generally meant to be an internal module.
+-- It's only exposed in case you want to make your own
+-- 'Spec'. If you just want to use JSON Schema Draft 4
+-- use the preassembled 'Data.JsonSchema.draft4' instead.
+--
+-- This module exposes three types of functions. To describe
+-- them we'll use the properties validators as an example.
+--
+-- 1. Functions that aren't followed by apostrophes have the
+-- type 'ValidatorGen' and are meant to be used in a 'Spec'.
+-- Examples are 'properties' and 'additionalProperties'.
+--
+-- 2. Functions that are followed by a single apostrophe, such
+-- as 'additionalProperties'', aren't meant to be used standalone
+-- in a 'Spec'. Instead they're used by other validators. For
+-- instance, 'additionalProperties' disables itself if the key
+-- "properties" is present to allow 'additionalProperties' to
+-- handle its validation. Placing the actual meat of
+-- 'additionalProperties' in 'additionalProperties'' allows for
+-- code reuse between 'properties' and 'additionalProperties'.
+--
+-- 3. Functions that are followed by a double apostrophe, such
+-- as 'patternProperties''', return an enhanced validator. It
+-- not only reports errors, but also the parts of the target
+-- data that it matches. These functions also aren't used in
+-- a 'Spec' instance, but are necessary helpers for actual
+-- validators in certain situations.
+
+module Data.JsonSchema.Validators where
+
+import           Control.Applicative
+import           Control.Monad
+import           Data.Aeson
+import           Data.Fixed                    (mod')
+import           Data.Hashable
+import           Data.HashMap.Strict           (HashMap)
+import qualified Data.HashMap.Strict           as H
+import           Data.JsonSchema.Core
+import           Data.JsonSchema.JsonReference
+import           Data.JsonSchema.Utils
+import           Data.Maybe
+import           Data.Monoid
+import           Data.Text                     (Text)
+import qualified Data.Text                     as T
+import           Data.Traversable
+import           Data.Vector                   (Vector)
+import qualified Data.Vector                   as V
+import           Text.RegexPR
+
+--------------------------------------------------
+-- Number Validators
+--------------------------------------------------
+
+multipleOf :: ValidatorGen
+multipleOf _ _ _ (Number val) = do
+  greaterThanZero val
+  Just (\x ->
+    case x of
+      (Number y) -> if y `mod'` val /= 0
+        then V.singleton $ tshow y <> " isn't a multiple of " <> tshow val
+        else mempty
+      _ -> mempty)
+multipleOf _ _ _ _ = Nothing
+
+maximumVal :: ValidatorGen
+maximumVal _ _ s (Number val) =
+  let f = case H.lookup "exclusiveMaximum" (_rsObject s) of
+            Just (Bool a) -> if a then (>=) else (>)
+            _             -> (>)
+  in Just (\x ->
+    case x of
+      (Number y) -> if y `f` val
+        then V.singleton $ tshow y <> " fails to validate against maximum " <> tshow val
+        else mempty
+      _ -> mempty)
+maximumVal _ _ _ _ = Nothing
+
+minimumVal :: ValidatorGen
+minimumVal _ _ s (Number val) =
+  let f = case H.lookup "exclusiveMinimum" (_rsObject s) of
+            Just (Bool a) -> if a then (<=) else (<)
+            _             -> (<)
+  in Just (\x ->
+    case x of
+      (Number y) -> if y `f` val
+        then V.singleton $ tshow y <> " fails to validate against minimum " <> tshow val
+        else mempty
+      _ -> mempty)
+minimumVal _ _ _ _ = Nothing
+
+--------------------------------------------------
+-- String Validators
+--------------------------------------------------
+
+maxLength :: ValidatorGen
+maxLength _ _ _ v = do
+  val <- fromJSONInt v
+  greaterThanZero val
+  Just (\x ->
+    case x of
+      (String y) -> if T.length y > val
+        then V.singleton $ y <> " is greater than maxLength " <> tshow val
+        else mempty
+      _ -> mempty)
+
+minLength :: ValidatorGen
+minLength _ _ _ v = do
+  val <- fromJSONInt v
+  greaterThanZero val
+  Just (\x ->
+    case x of
+      (String y) -> if T.length y < val
+        then V.singleton $ y <> " is less than minLength " <> tshow val
+        else mempty
+      _ -> mempty)
+
+pattern :: ValidatorGen
+pattern _ _ _ (String val) =
+  Just (\x ->
+    case x of
+      (String t) ->
+        case matchRegexPR (T.unpack val) (T.unpack t) of
+          Nothing -> V.singleton $ t <> " fails to validate against pattern " <> val
+          Just _  -> mempty
+      _ -> mempty)
+pattern _ _ _ _ = Nothing
+
+--------------------------------------------------
+-- Array Validators
+--------------------------------------------------
+
+-- | Also covers additionalItems.
+--
+-- We can leave additionalItems out of the spec HashMap, since items defaults to {},
+-- and if it isn't present additionalItems will always validate successfully.
+items :: ValidatorGen
+items spec g s (Object val) =
+  let sub = compile spec g (RawSchema (_rsURI s) val)
+  in Just (\x ->
+    case x of
+      (Array ys) -> ys >>= validate sub
+      _          -> mempty)
+items spec g s (Array vs) = do
+  os <- traverse toObj vs
+  let ss = compile spec g . RawSchema (_rsURI s) <$> os
+  let addItems = do
+        a <- H.lookup "additionalItems" (_rsObject s)
+        additionalItems' spec g s a
+  Just (\x ->
+    case x of
+      (Array ys) ->
+        let extras = V.drop (V.length os) ys
+        in join (V.zipWith validate ss ys) <> runMaybeVal addItems (Array extras)
+      _ -> mempty)
+items _ _ _ _ = Nothing
+
+additionalItems' :: ValidatorGen
+additionalItems' _ _ _ (Bool val) =
+  Just (\x ->
+    case x of
+      (Array ys) -> if not val && V.length ys > 0
+        then V.singleton "TODO"
+        else mempty
+      _ -> mempty)
+additionalItems' spec g s (Object val) =
+  let sub = compile spec g (RawSchema (_rsURI s) val)
+  in Just (\x ->
+    case x of
+      (Array ys) -> ys >>= validate sub
+      _          -> mempty)
+additionalItems' _ _ _ _ = Nothing
+
+maxItems :: ValidatorGen
+maxItems _ _ _ v = do
+  val <- fromJSONInt v
+  greaterThanZero val
+  Just (\x ->
+    case x of
+      (Array ys) -> if V.length ys > val
+        then V.singleton $ tshow ys <> " has more items than maxItems " <> tshow val
+        else mempty
+      _ -> mempty)
+
+minItems :: ValidatorGen
+minItems _ _ _ v = do
+  val <- fromJSONInt v
+  greaterThanZero val
+  Just (\x ->
+    case x of
+      (Array ys) -> if V.length ys < val
+        then V.singleton $ tshow ys <> " has fewer items than minItems " <> tshow val
+        else mempty
+      _ -> mempty)
+
+uniqueItems :: ValidatorGen
+uniqueItems _ _ _ (Bool val) = do
+  unless val Nothing
+  Just (\x ->
+    case x of
+      (Array ys) -> if allUnique ys
+        then mempty
+        else V.singleton "TODO"
+      _ -> mempty)
+uniqueItems _ _ _ _ = Nothing
+
+--------------------------------------------------
+-- Object Validators
+--------------------------------------------------
+
+maxProperties :: ValidatorGen
+maxProperties _ _ _ v = do
+  val <- fromJSONInt v
+  greaterThanZero val
+  Just (\x ->
+    case x of
+      (Object o) -> if H.size o > val
+        then V.singleton $ tshow o <> " has more members than maxProperties " <> tshow val
+        else mempty
+      _ -> mempty)
+
+minProperties :: ValidatorGen
+minProperties _ _ _ v = do
+  val <- fromJSONInt v
+  greaterThanZero val
+  Just (\x ->
+    case x of
+      (Object o) -> if H.size o < val
+        then V.singleton $ tshow o <> " has fewer members than minProperties " <> tshow val
+        else mempty
+      _ -> mempty)
+
+required :: ValidatorGen
+required _ _ _ (Array vs) = do
+  when (V.length vs == 0) Nothing
+  ts <- traverse toTxt vs
+  let a = vectorToMap ts
+  when (H.size a /= V.length ts) Nothing
+  Just (\x ->
+    case x of
+      (Object o) -> if H.size (H.difference a o) > 0
+        then V.singleton $ "the keys of " <> tshow o
+          <> " don't contain all the required elements " <> tshow vs
+        else mempty
+      _ -> mempty)
+  where
+    -- TODO: optimize
+    vectorToMap :: (Eq a, Hashable a) => Vector a -> HashMap a Bool
+    vectorToMap vec = H.fromList $ zip (V.toList vec) (repeat True)
+required _ _ _ _ = Nothing
+
+-- TODO: Fix up the properties* validators. They're all a huge mess, but at least
+-- they work.
+--
+-- In order of what's tried: properties, patternProperties, additionalProperties
+properties :: ValidatorGen
+properties spec g s v = do
+  let mProps = properties'' spec g s v
+  let mPatProp = do
+                  aV <- H.lookup "patternProperties" (_rsObject s)
+                  patternProperties'' spec g s aV
+  let mAdd = do
+              aVal <- H.lookup "additionalProperties" (_rsObject s)
+              additionalProperties' spec g s aVal
+  when (isNothing mProps && isNothing mPatProp && isNothing mAdd) Nothing
+  Just (\x ->
+    case x of
+      (Object y) -> -- Got myself into a mess here.
+        let (e1s, remaining) = runMaybeVal' mProps (Object y)
+            (_, remaining') = runMaybeVal' mPatProp remaining
+            (e2s, _) = runMaybeVal' mPatProp (Object y)
+        in e1s <> e2s <> runMaybeVal mAdd remaining'
+      _ -> mempty)
+
+-- TODO: optimize
+properties''
+  :: Spec
+  -> Graph
+  -> RawSchema
+  -> Value
+  -> Maybe (Value -> (Vector ValErr, Value))
+properties'' spec g s (Object val) = do
+  os <- traverse toObj val
+  let oss = compile spec g . RawSchema (_rsURI s) <$> os
+  Just (\x ->
+    case x of
+      (Object y) -> ( join . V.fromList . H.elems $ H.intersectionWith validate oss y
+                    , Object (H.difference y oss))
+      z          -> (mempty, z))
+properties'' _ _ _ _ = Nothing
+
+-- TODO: optimize
+patternProperties''
+  :: Spec
+  -> Graph
+  -> RawSchema
+  -> Value
+  -> Maybe (Value -> (Vector ValErr, Value))
+patternProperties'' spec g s (Object val) = do
+  os <- traverse toObj val
+  let vs = compile spec g . RawSchema (_rsURI s) <$> os
+  Just (\x ->
+    case x of
+      (Object y) -> let ms = matches (V.fromList . H.toList $ vs) <$> (V.fromList . H.toList $ y)
+                    in (ms >>= runVals, leftovers ms)
+      _          -> (mempty, x))
+  where
+    matches :: Vector (Text, Schema) -> (Text, Value) -> (Text, Value, Vector Schema)
+    matches ss (k, v) = (k, v, ss >>= match k)
+
+    match :: Text -> (Text, Schema) -> Vector Schema
+    match k (r, sc) =
+      case matchRegexPR (T.unpack r) (T.unpack k) of
+        Nothing -> mempty
+        Just _  -> V.singleton sc
+
+    runVals :: (Text, Value, Vector Schema) -> Vector ValErr
+    runVals (_,v,ss) = join $ validate <$> ss <*> pure v
+
+    leftovers :: Vector (Text, Value, Vector Schema) -> Value
+    leftovers possiblyMatched =
+      let unmatched = V.filter (\(_,_,ss) -> V.length ss == 0) possiblyMatched
+      in Object . H.fromList . V.toList $ (\(v,k,_) -> (v,k)) <$> unmatched
+
+patternProperties'' _ _ _ _ = Nothing
+
+patternProperties :: ValidatorGen
+patternProperties spec g s v = do
+  when (H.member "properties" (_rsObject s)) Nothing
+  let mPatProp = patternProperties'' spec g s v
+  -- TODO: checking additionalProperties as well doesn't help with tests
+  let mAdd = do
+              aVal <- H.lookup "additionalProperties" (_rsObject s)
+              additionalProperties' spec g s aVal
+  when (isNothing mPatProp && isNothing mAdd) Nothing
+  Just (\x ->
+    case x of
+      (Object y) ->
+        let (e2s, remaining') = runMaybeVal' mPatProp (Object y)
+        in e2s <> runMaybeVal mAdd remaining'
+      _ -> mempty)
+
+additionalProperties' :: ValidatorGen
+additionalProperties' _ _ _ (Bool val) =
+  Just (\x ->
+    case x of
+      (Object y) -> if val || H.size y == 0
+        then mempty
+        else V.singleton "TODO"
+      _ -> mempty)
+additionalProperties' spec g s (Object val) =
+  let sub = compile spec g (RawSchema (_rsURI s) val)
+  in Just (\x ->
+    case x of
+      (Object y) -> (V.fromList . H.elems $ y) >>= validate sub -- TODO: optimize
+      _          -> mempty)
+additionalProperties' _ _ _ _ = Nothing
+
+additionalProperties :: ValidatorGen
+additionalProperties spec g s v = do
+  when (H.member "properties" (_rsObject s)) Nothing
+  when (H.member "patternProperties" (_rsObject s)) Nothing
+  additionalProperties' spec g s v
+
+-- TODO: optimize
+--
+-- http://json-schema.org/latest/json-schema-validation.html#anchor70
+--
+--  This keyword's value MUST be an object.
+--  Each value of this object MUST be either an object or an array.
+--
+-- If the value is an object, it MUST be a valid JSON Schema.
+-- This is called a schema dependency.
+--
+-- If the value is an array, it MUST have at least one element.
+-- Each element MUST be a string, and elements in the array MUST be unique.
+-- This is called a property dependency.
+dependencies :: ValidatorGen
+dependencies spec g s (Object val) = do
+  let vs = V.fromList $ H.toList val
+  let schemaDeps = vs >>= toSchemaDep spec g
+  let propDeps = vs >>= toPropDep
+  when (V.length schemaDeps + V.length propDeps /= V.length vs) Nothing
+  Just (\x ->
+    case x of
+      (Object y) -> join $ (valSD <$> schemaDeps <*> pure y) <> (valPD <$> propDeps <*> pure y)
+      _          -> mempty)
+  where
+    toSchemaDep :: Spec -> Graph -> (Text, Value) -> Vector (Text, Schema)
+    toSchemaDep spc gr (t, Object o) = V.singleton (t, compile spc gr $ RawSchema (_rsURI s) o)
+    toSchemaDep _ _ _ = mempty
+
+    toPropDep :: (Text, Value) -> Vector (Text, Vector Text)
+    toPropDep (t, Array a) =
+      if V.length a <= 0
+        then mempty
+        else case traverse toTxt a of
+          Nothing -> mempty
+          Just ts ->
+            if allUnique ts
+              then V.singleton (t, ts)
+              else mempty
+    toPropDep _ = mempty
+
+    valSD :: (Text, Schema) -> HashMap Text Value -> Vector ValErr
+    valSD (t, sub) d =
+      case H.lookup t d of
+        Nothing -> mempty
+        Just _  -> validate sub (Object d)
+
+    valPD :: (Text, Vector Text) -> HashMap Text Value -> Vector ValErr
+    valPD (t, ts) d =
+      case H.lookup t d of
+        Nothing -> mempty
+        Just _  ->
+          case traverse ($ d) (H.lookup <$> ts) of
+            Nothing -> V.singleton "TODO at least one failed"
+            Just _  -> mempty
+
+dependencies _ _ _ _ = Nothing
+
+--------------------------------------------------
+-- Any Validators
+--------------------------------------------------
+
+enum :: ValidatorGen
+enum _ _ _ (Array vs) = do
+  unless (V.length vs > 0 && allUnique vs) Nothing
+  Just (\x ->
+    if V.elem x vs
+      then mempty
+      else V.singleton $ tshow x <> " is not an element of enum " <> tshow vs)
+enum _ _ _ _ = Nothing
+
+typeVal :: ValidatorGen
+typeVal _ _ _ (String val) = Just (\x -> isJsonType x (V.singleton val))
+typeVal _ _ _ (Array vs) = do
+  ts <- traverse toTxt vs
+  unless (allUnique ts) Nothing
+  Just (`isJsonType` ts)
+typeVal _ _ _ _ = Nothing
+
+allOf :: ValidatorGen
+allOf spec g s (Array vs) = do
+  os <- traverse toObj vs
+  let ss = compile spec g . RawSchema (_rsURI s) <$> os
+  Just (\x -> join $ validate <$> ss <*> pure x)
+allOf _ _ _ _ = Nothing
+
+anyOf :: ValidatorGen
+anyOf spec g s (Array vs) = do
+  os <- traverse toObj vs
+  let ss = compile spec g . RawSchema (_rsURI s) <$> os
+  Just (\x ->
+    if V.elem V.empty (validate <$> ss <*> pure x)
+      then mempty
+      else V.singleton "TODO")
+anyOf _ _ _ _ = Nothing
+
+oneOf :: ValidatorGen
+oneOf spec g s (Array vs) = do
+  os <- traverse toObj vs
+  let ss = compile spec g . RawSchema (_rsURI s) <$> os
+  Just (\x ->
+    if count V.empty (validate <$> ss <*> pure x) == 1
+      then mempty
+      else V.singleton "TODO")
+oneOf _ _ _ _ = Nothing
+
+notValidator :: ValidatorGen
+notValidator spec g s (Object val) = do
+  let sub = compile spec g (RawSchema (_rsURI s) val)
+  Just (\x ->
+    if V.null $ validate sub x
+      then V.singleton "TODO"
+      else mempty)
+notValidator _ _ _ _ = Nothing
+
+-- http://tools.ietf.org/html/draft-pbryan-zyp-json-ref-03
+--
+-- TODO: Any members other than "$ref" in a JSON Reference object SHALL be
+-- ignored.
+ref :: ValidatorGen
+ref spec g s (String val) = do
+  (reference, pointer) <- refAndP (_rsURI s `combineIdAndRef` val)
+  r <- RawSchema reference <$> H.lookup reference g
+  sc <- pointerToSchema pointer r
+  Just $ validate (compile spec g sc)
+  where
+    pointerToSchema :: Text -> RawSchema -> Maybe RawSchema
+    pointerToSchema pntr rawS = do
+      mVal <- jsonPointer pntr (Object . _rsObject $ rawS)
+      case mVal of
+        (Object o) -> Just $ RawSchema (_rsURI rawS) o
+        _           -> Nothing
+ref _ _ _ _ = Nothing
diff --git a/tests/Test.hs b/tests/Test.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Main where
+
+import           Control.Applicative
+import           Control.Monad
+import           Data.Aeson
+import           Data.Aeson.TH
+import qualified Data.ByteString.Lazy           as LBS
+import           Data.Char                      (toLower)
+import qualified Data.HashMap.Strict            as H
+import           Data.JsonSchema
+import           Data.List                      (isSuffixOf)
+import           Data.Monoid
+import           Data.Text                      (Text)
+import qualified Data.Text                      as T
+import qualified Data.Vector                    as V
+import           System.Directory               (getDirectoryContents)
+import           System.FilePath                ((</>))
+import           Test.Framework
+import           Test.Framework.Providers.HUnit
+import qualified Test.HUnit                     as HU
+
+main :: IO ()
+main = do
+  ts <- readSchemaTests
+  defaultMain (toTest <$> ts)
+
+data SchemaTest = SchemaTest
+  { _stDescription :: Text
+  , _stSchema      :: RawSchema
+  , _stCases       :: [SchemaTestCase]
+  }
+
+data SchemaTestCase = SchemaTestCase
+  { _scDescription :: Text
+  , _scData        :: Value
+  , _scValid       :: Bool
+  }
+
+instance FromJSON RawSchema where
+  parseJSON = withObject "Schema" $ \o ->
+    return $ RawSchema "" o
+
+instance FromJSON SchemaTest where
+  parseJSON = withObject "SchemaTest" $ \o -> SchemaTest
+    <$> o .: "description"
+    <*> o .: "schema"
+    <*> o .: "tests" -- I wish this were "cases"
+
+readSchemaTests :: IO [SchemaTest]
+readSchemaTests = do
+  jsonFiles <- filter (".json" `isSuffixOf`) <$> getDirectoryContents dir
+  fmap concat $ forM jsonFiles $ \file -> do
+    let fullPath = dir </> file
+    jsonBS <- LBS.readFile fullPath
+    case eitherDecode jsonBS of
+      Left err      -> fail $ "couldn't parse file '" <> fullPath <> "': " <> err
+      Right schemas -> return $ prependFileName file <$> schemas
+  where
+    dir = "JSON-Schema-Test-Suite/tests/draft4"
+    prependFileName :: String -> SchemaTest -> SchemaTest
+    prependFileName fileName s = s
+      { _stDescription = T.pack fileName <> ": " <> _stDescription s
+      }
+
+toTest :: SchemaTest -> Test
+toTest st = testGroup groupName (mkCase <$> _stCases st)
+  where
+    groupName :: String
+    groupName = T.unpack $ _stDescription st
+
+    mkCase :: SchemaTestCase -> Test
+    mkCase sc = testCase caseName assertion
+      where
+        caseName = T.unpack $ _scDescription sc
+        assertion = if _scValid sc
+          then assertValid   (_stSchema st) (_scData sc)
+          else assertInvalid (_stSchema st) (_scData sc)
+
+assertValid, assertInvalid :: RawSchema -> Value -> HU.Assertion
+assertValid r v = do
+  g <- fetchRefs r H.empty
+  let es = validate (compile draft4 g r) v
+  unless (V.length es == 0) $ HU.assertFailure (show es)
+assertInvalid r v = do
+  g <- fetchRefs r H.empty
+  let es = validate (compile draft4 g r) v
+  when (V.length es == 0) $ HU.assertFailure "expected a validation error"
+
+$(deriveFromJSON defaultOptions { fieldLabelModifier = map toLower . drop 3 } ''SchemaTestCase)