diff --git a/auth-server/src/Application.hs b/auth-server/src/Application.hs
index 6124c0b..a0c141f 100644
--- a/auth-server/src/Application.hs
+++ b/auth-server/src/Application.hs
@@ -10,12 +10,12 @@ module Application where
 ------------------------------------------------------------------------------
 import Control.Lens
 import Snap
-import Model.Contract
+--import Model.Contract
 
 ------------------------------------------------------------------------------
 
 data App = App
-    { _contracts     :: [Contract]
+    { -- _contracts     :: [Contract]
     }
 
 makeLenses ''App
diff --git a/auth-server/src/Site.hs b/auth-server/src/Site.hs
index 4ed97c9..90b73f2 100644
--- a/auth-server/src/Site.hs
+++ b/auth-server/src/Site.hs
@@ -11,20 +11,17 @@ module Site where
 
 ------------------------------------------------------------------------------
 import           Control.Monad.IO.Class
-import           Crypto.Random
-import           Data.Aeson
 import qualified Data.ByteString.Char8 as C
-import qualified Data.ByteString.Lazy.Char8 as CL
 import qualified Data.List as L
 import           Data.Maybe
 import           Data.Time
-import qualified Data.Text as T
 import qualified Safe
 import qualified System.Entropy as Entropy
 import           System.Random
 import           Snap
 ------------------------------------------------------------------------------
 import           Application
+import qualified Db
 import qualified Messages.RqAuth as RQA
 import qualified Messages.RespAuth as REA
 import qualified Model.Challenge as Challenge
@@ -33,21 +30,15 @@ import qualified Model.Token as Token
 import qualified Model.User as User
 import qualified Model.UUID as UUID
 import           Model.URI
-import qualified BusinessLogic as Db -- TODO: Move all the business' logic code into this module.
 import qualified Util.Base64 as B64
 import           Util.HttpResponse
 import           Util.JSONWebToken
 
 
-
 ------------------------------------------------------------------------------ | Handler that authenticates users.
 auth :: Handler App App ()
 auth = do
     rq <- getRequest
-    --let rqAuth = do
-    --        info <- getHeader "JWT" rq
-    --        decode . B64.decode . BL.fromStrict $ info
-    --maybe unauthorized handlerRqAuth rqAuth
     case getHeader "JWT" rq of
         Just jwtCompact -> do
             (rqAuth :: Maybe RQA.RqAuth) <- liftIO $ fromCompactJWT jwtCompact
@@ -61,7 +52,7 @@ handlerRqAuth (RQA.RqAuth01 challengeUUID credentialValue) =
     verifyChallengeCredential :: AppHandler Contract.Contract
     verifyChallengeCredential = do
         liftIO $ putStrLn "Verifying credential challenge..."
-        contracts <- gets _contracts
+        contracts <- liftIO Db.selectAllContracts
         let maybeContract =
                 L.find (\c -> any (\chal -> Challenge.uuid chal == challengeUUID
                                             && Challenge.answer chal == credentialValue)
@@ -76,7 +67,7 @@ handlerRqAuth (RQA.RqAuth01 challengeUUID credentialValue) =
         index <- liftIO $ liftM (fst . randomR (0, length users - 1)) newStdGen
         let user = users !! index
         uuid <- liftIO UUID.nextRandom 
-        now <- liftIO $ getCurrentTime
+        now <- liftIO getCurrentTime
         let challenge = Challenge.Challenge {
             Challenge.uuid         = uuid,
             Challenge.answer       = C.concat [User.login user, "-", User.password user],
@@ -84,7 +75,9 @@ handlerRqAuth (RQA.RqAuth01 challengeUUID credentialValue) =
         }
         liftIO $ putStrLn "Challenge is..."
         liftIO $ print challenge
-        -- TODO: Persist challenge in the database!
+        -- Persist challenge in the database!
+        let newChallengeList = challenge : Contract.challengesAuth contract
+        liftIO $ Db.updateContract contract { Contract.challengesAuth = newChallengeList }
         return (challenge, user)
 
     makeResponse :: (Challenge.Challenge, User.User) -> AppHandler ()
@@ -107,7 +100,7 @@ handlerRqAuth (RQA.RqAuth02 challengeUUID login password) =
     verifyChallengeAuth :: AppHandler Contract.Contract
     verifyChallengeAuth = do
         liftIO $ putStrLn "Verifying auth challenge..."
-        contracts <- gets _contracts
+        contracts <- liftIO Db.selectAllContracts
         let answer = C.concat [login, "-", password]
             maybeContract =
                 L.find (\c -> any (\chal -> Challenge.uuid chal == challengeUUID
@@ -127,7 +120,7 @@ handlerRqAuth (RQA.RqAuth02 challengeUUID login password) =
         -- TODO: Improve design in "case of". Duplicated code.
         case maybeToken of
             Just token -> do
-                now <- liftIO $ getCurrentTime
+                now <- liftIO getCurrentTime
                 if Token.expirationDate token > now
                     then do
                         liftIO $ putStr ">> Found: "
@@ -138,8 +131,8 @@ handlerRqAuth (RQA.RqAuth02 challengeUUID login password) =
                         newToken <- generateAuthToken
                         let newTokenList = newToken : Contract.tokens contract
                             newContract = contract { Contract.tokens = newTokenList }
-                        -- TODO: Persist updated contract!
-                        liftIO $ print newContract
+                        -- Persist updated contract!
+                        liftIO $ Db.updateContract newContract
                         return newToken
 
             _ -> do
@@ -147,8 +140,8 @@ handlerRqAuth (RQA.RqAuth02 challengeUUID login password) =
                 newToken <- generateAuthToken
                 let newTokenList = newToken : Contract.tokens contract
                     newContract = contract { Contract.tokens = newTokenList }
-                liftIO $ print newContract
-                -- TODO: Persist updated contract!
+                -- Persist updated contract!
+                liftIO $ Db.updateContract newContract
                 return newToken
       where
         -- The method I'm using to generate random bytes can be an overhead
@@ -159,14 +152,14 @@ handlerRqAuth (RQA.RqAuth02 challengeUUID login password) =
         generateAuthToken = do
             liftIO $ putStrLn "Generating auth token..."
             token <- liftIO $ liftM B64.encode' $ Entropy.getEntropy 64 -- Size in bytes.
-            now <- liftIO $ getCurrentTime
+            now <- liftIO getCurrentTime
             let newToken = Token.Token {
                                 Token.value          = token,
                                 Token.creationDate   = now,
                                 Token.expirationDate = addUTCTime 3600 now
                            }
             liftIO $ putStr ">> New token: "
-            liftIO $ C.putStrLn $ token
+            liftIO $ C.putStrLn token
             return newToken
 
     makeResponse :: Token.Token -> AppHandler ()
@@ -177,65 +170,6 @@ handlerRqAuth (RQA.RqAuth02 challengeUUID login password) =
         let response = setHeader "JWT" jwt emptyResponse
         finishWith response
     
-
---handlerRqAuth rq@(RQA.RqAuth01 cred chalCode contrCode) = do
---    liftIO $ do
---        putStrLn "Processing auth request..."
---        print rq
---        putStrLn "======================================================"
---    r <- query "SELECT cod_usuario FROM tb_desafio WHERE cod_desafio = ? AND resposta_desafio = ?" (chalCode, cred)
---    case r of
---        [(Only _ :: Only Int)] -> do
---            r' <- query "SELECT cod_usuario, login, password FROM tb_usuario WHERE cod_contrato = ? ORDER BY RANDOM() LIMIT 1;" (Only contrCode)
---            case r' of
---                [(userCode', login, pw) :: (Int, String, String)] -> do
---                    datetime <- liftIO $ getCurrentTime
---                    execute "INSERT INTO tb_desafio VALUES (NULL, ?, ?, ?, ?)" (contrCode, userCode', login ++ "-" ++ pw , datetime)
---                    r'' <- query_ "SELECT last_insert_rowid()"
---                    case r'' of
---                        [(Only chalCode' :: Only Int)] -> do
---                            req <- getRequest
---                            let url = "https://" ++ (C.unpack $ rqServerName req)
---                                      ++ ':' : (show $ rqServerPort req)
---                                      ++ "/auth"
---                                response = REA.RespAuth01 chalCode' userCode' (fromJust $ parseURI url)
---                            --modifyResponse (setHeader "JWT" $ BL.toStrict . B64.encode . encode $ response) -- put response in header. 
---                            resp <- liftIO $ toCompactJWT response
---                            modifyResponse (setHeader "JWT" resp) -- put response in header. 
---                        _ -> writeBS "FALHOU!"
---                _ -> writeBS "FALHOU!"
---        _  -> writeBS "FALHOU!"
---
---handlerRqAuth (RQA.RqAuth02 chalCode login senha) = do
---    let chalResp = login `T.append` "-" `T.append` senha
---    r <- query "SELECT cod_contrato, date_time FROM tb_desafio WHERE cod_desafio = ? AND resposta_desafio = ?" (chalCode, chalResp)
---    case r of
---        [(contrCode, datetime) :: (Int, UTCTime)] -> do
---            datetimeNow <- liftIO $ getCurrentTime
---            let diff = diffUTCTime datetimeNow datetime
---            if diff >= 0 && diff <= 10000 -- 3000 segundos, ideal 10s
---                then do
---                    g <- liftIO $ (newGenIO :: IO SystemRandom)
---                    case genBytes 64 g of
---                        Left _          -> writeBS "GEN: It shouldn't happen :-("
---                        Right (cred, _) -> do
---                            r' <- query "SELECT cod_contrato_servico FROM tb_contrato_servico WHERE cod_contrato = ?" (Only contrCode)
---                            case r' of
---                                (xs :: [[Int]]) -> do
---                                    datetime' <- liftIO $ getCurrentTime
---                                    let datetimeExp = addUTCTime 3600 datetime'
---                                        cred' = CL.toStrict $ B64.encode' cred
---                                    mapM_ (\c -> execute "INSERT INTO tb_servico_credencial VALUES (NULL, ?, ?, ?, ?)" (c, cred', datetime, datetimeExp)) (concat xs)  
---                                    let response = REA.RespAuth02 True cred'
---                                    --modifyResponse (setHeader "JWT" $ BL.toStrict . B64.encode . encode $ response) -- put response in header. 
---                                    resp <- liftIO $ toCompactJWT response
---                                    modifyResponse (setHeader "JWT" resp) -- put response in header. 
---                                _ -> writeBS "CAIU AQUI!!!" >> unauthorized
---                else do
---                    writeBS $ C.pack $ "Not Authenticated!\n\nDiff time is: " ++ show diff
---        _ -> writeBS "AQUI!"
-
-
 ------------------------------------------------------------------------------
 -- | The application's routes.
 routes :: [(C.ByteString, Handler App App ())]
@@ -247,7 +181,6 @@ routes = [ ("/auth", auth)
 -- | The application initializer.
 app :: SnapletInit App App
 app = makeSnaplet "auth-server" "REST-based authentication server." Nothing $ do
-    eitherContract <- liftIO $ liftM eitherDecode $ CL.readFile "model.json"
     addRoutes routes
-    return $ App (either error (:[]) eitherContract)
+    return App
 
diff --git a/facade-server/model.json b/facade-server/model.json
index a890980..362ef67 100644
--- a/facade-server/model.json
+++ b/facade-server/model.json
@@ -1,5 +1,6 @@
 {
-    "uuid": "1f1c7954-3628-4890-b1ee-bbeca6bbd619",
+    "_id": "1f1c7954-3628-4890-b1ee-bbeca6bbd619",
+    "_rev": "1f1c7954-3628-4890-b1ee-bbeca6bbd619",
     "name": "TJDFT",
     "description": "Contrato do TJDFT",
     "creationDate": "2014-03-16T20:23:42.620Z",
diff --git a/facade-server/src/Application.hs b/facade-server/src/Application.hs
index 0b51ef5..2baa8b6 100644
--- a/facade-server/src/Application.hs
+++ b/facade-server/src/Application.hs
@@ -10,14 +10,14 @@ module Application where
 ------------------------------------------------------------------------------
 import Control.Lens
 import Snap
-import Model.Contract
+--import Model.Contract
 import Model.URI
 
 ------------------------------------------------------------------------------
 
 data App = App
     { _authServerURL :: URI
-    , _contracts     :: [Contract]
+--    , _contracts     :: [Contract]
     }
 
 makeLenses ''App
diff --git a/facade-server/src/Db.hs b/facade-server/src/Db.hs
deleted file mode 100644
index e0a6940..0000000
--- a/facade-server/src/Db.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable  #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Db where
-
-import           Data.Aeson
-import           Control.Applicative
-import           Control.Monad.IO.Class            (MonadIO, liftIO)
-import           Control.Monad
---import Control.Monad.Trans.Resource (MonadThrow, MonadUnsafeIO)
---import Control.Monad.Trans.Control (MonadBaseControl)
-import           Data.ByteString                   (ByteString)
-import           Database.CouchDB.Conduit
-import           Database.CouchDB.Conduit.Explicit
-
-conn :: CouchConnection
-conn = def
-
-data User = User {
-    name :: String
-} deriving (Eq, Show)
-
-instance FromJSON User where
-    parseJSON (Object v) =
-        User <$> v .: "name"
-    parseJSON _ = mzero
-
-instance ToJSON User where
-    toJSON (User n) =
-        object [ "name" .= n ]
-
-couchTest :: IO ()
--- couchTest :: IO () -- restricting it to IO is also an option
-couchTest = runCouch conn $ do
-    rev <- couchPut "mydb" "doc" "1-6c76a52aea92ddbbbdc5d0bc0dfb3f44" [] $ User { name = "alexandre lucchesi" }
---    (rev, user :: User) <- couchGet "mydb" "doc" []
-    liftIO $ putStrLn $ "Rev: " ++ show rev
---    liftIO $ putStrLn $ "User info: " ++ show user
---    couchPut' "mydb" "my-doc1" [] $ D 12345 "third"    -- notice - no rev
---    rev3 <- couchRev "mydb" "my-doc1"
---    couchDelete "mydb" "my-doc1" rev3
-
diff --git a/facade-server/src/Site.hs b/facade-server/src/Site.hs
index f37e33a..57ad8b2 100644
--- a/facade-server/src/Site.hs
+++ b/facade-server/src/Site.hs
@@ -8,9 +8,7 @@ module Site where
 ------------------------------------------------------------------------------
 import           Control.Applicative
 import           Control.Monad.IO.Class
-import           Data.Aeson
 import qualified Data.ByteString.Char8 as C
-import qualified Data.ByteString.Lazy.Char8 as CL
 import           Data.Char (toUpper)
 import qualified Data.Configurator as Config
 import qualified Data.List as L
@@ -18,9 +16,6 @@ import qualified Network as HC (withSocketsDo)
 import qualified Network.HTTP.Conduit as HC
 import qualified Network.HTTP.Types.Status as HC
 import           Data.Time
-import           Data.Maybe
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
 import           Data.Word
 import           Snap
 import           Snap.Extras.CoreUtils
@@ -29,6 +24,7 @@ import           Snap.Types.Headers
 import           System.Random
 ------------------------------------------------------------------------------
 import           Application
+import qualified Db
 import qualified Messages.RqFacade as RQF
 import qualified Messages.RespFacade as REF
 import qualified Model.Challenge as Challenge
@@ -52,29 +48,6 @@ facade = do
             maybe badRequest handlerRqFacade rqFacade
         _ -> badRequest
 
-forward :: Method -> URI -> Handler App b ()
-forward meth url = do
-    respService <- liftIO $ HC.withSocketsDo $ do 
-        initReq <- HC.parseUrl $ show url
-        let req = initReq { HC.checkStatus = \_ _ _ -> Nothing
-                          , HC.method = methodToStr meth }
-        liftIO $ C.putStrLn "Forwarding request..."
-        liftIO $ print req
-        liftIO $ C.putStrLn "==================================================="
-        HC.withManager $ HC.httpLbs req
-    let resp = emptyResponse { rspHeaders = fromList $ HC.responseHeaders respService
-                             , rspStatus  = HC.statusCode $ HC.responseStatus respService
-                             , rspStatusReason  = HC.statusMessage $ HC.responseStatus respService }
-    putResponse resp
-    writeLBS $ HC.responseBody respService
-  where
-    methodToStr GET        = "GET"
-    methodToStr POST       = "POST"
-    methodToStr PUT        = "PUT"
-    methodToStr DELETE     = "DELETE"
-    methodToStr (Method m) = C.pack . map toUpper . C.unpack $ m
-    methodToStr _          = error "Not acceptable method."
-                                
 ------------------------------------------------------------------------------ | Handler that treats requests to Facade Server.
 handlerRqFacade :: RQF.RqFacade -> AppHandler ()
 handlerRqFacade (RQF.RqFacade01 contractUUID credentialValue) =
@@ -83,7 +56,7 @@ handlerRqFacade (RQF.RqFacade01 contractUUID credentialValue) =
     verifyCredential :: AppHandler Contract.Contract
     verifyCredential = do
         liftIO $ putStrLn "Verifying contract/credential..."
-        contracts <- gets _contracts
+        contracts <- liftIO $ Db.selectAllContracts
         let maybeContract = L.find (\c -> Contract.uuid c == contractUUID
                                           && any (\cred -> Credential.value cred == credentialValue)
                                                  (Contract.credentials c)
@@ -108,6 +81,9 @@ handlerRqFacade (RQF.RqFacade01 contractUUID credentialValue) =
         }
         liftIO $ putStr ">> Challenge is: "
         liftIO $ print challenge
+        -- Persist challenge in the database!
+        let newChallengeList = challenge : Contract.challengesCredential contract
+        liftIO $ Db.updateContract contract { Contract.challengesCredential = newChallengeList }
         return (challenge, credential)
 
     redirectToAuthServer :: (Challenge.Challenge, Credential.Credential) -> AppHandler ()
@@ -137,7 +113,7 @@ handlerRqFacade (RQF.RqFacade02 contractUUID credentialValue authorizationTokenV
 
         liftIO $ putStrLn $ "Service requested: " ++ show requestedService
 
-        contracts <- gets _contracts
+        contracts <- liftIO $ Db.selectAllContracts
         let maybeContract = L.find (\c -> Contract.uuid c == contractUUID)
                                    contracts
         contract <- maybe forbidden return maybeContract
@@ -214,65 +190,6 @@ handlerRqFacade (RQF.RqFacade02 contractUUID credentialValue authorizationTokenV
                                RQF.credential   = credentialValue 
                           }
 
---  where
---    allow = with db $ do
---        req  <- getRequest
---        let service = rqPathInfo req -- Service identifier
---
---        liftIO $ putStrLn $ "Service requested: " ++ show service
---        serviceExists <- Db.serviceExists service
---        canAccess <- maybe pass (\cred -> Db.canAccessService (fromIntegral contrCode)
---                                    (T.encodeUtf8 cred) service
---                                ) authorCred
---
---        liftIO $ putStrLn $ ">> Service exists: " ++ show serviceExists
---        liftIO $ putStrLn $ ">> Can access    : " ++ show canAccess
---
---        if isJust authorCred -- An authorization credential was passed.
---            then if isJust serviceExists
---                    then if canAccess
---                            then forward (rqMethod req) $ fromJust $
---                                serviceExists >>= \url ->
---                                parseURI $ show url ++ 
---                                    let q = C.unpack . rqQueryString $ req
---                                    in if Prelude.null q
---                                            then ""
---                                            else '?' : q
---                            else forbidden -- Can't access! :-(
---                    else notFound "Not found" -- Requested service does not exist!
---            else pass
---
---    redirectAuth' = do
---        r <- query "SELECT cod_contrato, cod_usuario, cod_credencial, credencial FROM tb_credencial WHERE cod_contrato = ? AND cod_usuario = ? ORDER BY RANDOM() LIMIT 1;" (contrCode)
---
---
---    redirectAuth = do
---        let authCredential = RQF.authCredential rq
---        r <- query "SELECT cod_contrato, cod_usuario FROM tb_credencial WHERE credencial = ?" (Only authCredential)
---        case r of
---            [(contrCode, userCode) :: (Int, Int)] -> genChallenge contrCode userCode 
---            _ -> unauthorized
---      where
---        genChallenge :: Int -> Int -> Handler App App ()
---        genChallenge contrCode userCode = do
---            r' <- query "SELECT cod_contrato, cod_usuario, cod_credencial, credencial FROM tb_credencial WHERE cod_contrato = ? AND cod_usuario = ? ORDER BY RANDOM() LIMIT 1;" (contrCode, userCode)
---            case r' of
---                [(contrCode', userCode', credCode, cred) :: (Int, Int, Int, T.Text)] -> do
---                    t <- liftIO $ getCurrentTime
---                    execute "INSERT INTO tb_desafio VALUES (NULL, ?, ?, ?, ?)" (contrCode', userCode', cred, t)
---                    r'' <- query_ "SELECT last_insert_rowid()"
---                    case r'' of
---                        [(Only chalCode)] -> do
---                            url <- gets _authServerURL
---                            let authURL  = fromJust $ parseURI ("https://" ++ url ++ "/auth")
---                                response = REF.RespFacade01 authURL chalCode credCode userCode'
---                            --modifyResponse (setHeader "JWT" $ BL.toStrict . B64.encode . encode $ response) -- put response in header. 
---                            resp <- liftIO $ toCompactJWT response
---                            modifyResponse (setHeader "JWT" resp) -- put response in header. 
---                            unauthorized
---                        _ -> writeBS "FALHOU!"
---                _ -> writeBS "FALHOU!" 
-
 ------------------------------------------------------------------------------
 -- | The application's routes.
 routes :: [(C.ByteString, Handler App App ())]
@@ -284,9 +201,8 @@ app :: SnapletInit App App
 app = makeSnaplet "facade-server" "Facade to RESTful web-services." Nothing $ do
     config <- liftIO $ Config.load [Config.Required "resources/devel.cfg"]
     url <- getAuthServerURL config
-    eitherContract <- liftIO $ liftM eitherDecode $ CL.readFile "model.json"
     addRoutes routes
-    return $ App url (either error (:[]) eitherContract)
+    return $ App url
   where
     getAuthServerURL config = do
         host <- liftIO $ Config.lookupDefault "localhost" config "host" 
diff --git a/facade-server/src/Test.hs b/facade-server/src/Test.hs
index 5eb7bbe..2f08254 100644
--- a/facade-server/src/Test.hs
+++ b/facade-server/src/Test.hs
@@ -6,12 +6,15 @@ import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as C (map)
 import           Data.Char (toUpper)
 import qualified Data.Map          as M
+import           Data.Time (getCurrentTime)
 import qualified Messages.RqFacade as RQF
 import           Site
 --import           Snap.Internal.Http.Types (Method)
 import           Snap.Snaplet.Test
 import qualified Snap.Test         as ST
 
+import qualified Db
+import qualified Model.Contract as Contract
 import qualified Model.UUID as UUID
 
 type ContractUUID = UUID.UUID
@@ -28,6 +31,14 @@ testRqFacade01 contractUUID credential = do
                   RQF.credential   = credential
               }
 
+--testtemp :: IO ()
+--testtemp = do
+--    let rqBuilder = ST.get "/hello" M.empty
+--    resp <- runHandler message rqBuilder temp app
+--    print resp
+--  where
+--    message = Just "Requests to Facade Server providing only the contract code and a credential."
+--
 type AuthorizationToken = ByteString
 type Method = ByteString
 type Service = ByteString
@@ -49,4 +60,47 @@ testRqFacade02 contractUUID credential authorizationToken method service = do
                   RQF.authorizationToken = authorizationToken
               }
 
+-- DATABASE
+testCreateContract :: IO ()
+testCreateContract = do
+    now <- getCurrentTime
+    let contract = mockContract now
+    newContract <- Db.createContract contract
+    print newContract
+  where
+    mockContract creationDate =
+        Contract.Contract { Contract.uuid                 = UUID.nil
+                          , Contract.revision             = ""
+                          , Contract.name                 = "TJDFT"
+                          , Contract.description          = "TDFT contract description."
+                          , Contract.creationDate         = creationDate
+                          , Contract.users                = []
+                          , Contract.services             = []
+                          , Contract.credentials          = []
+                          , Contract.challengesCredential = []
+                          , Contract.challengesAuth       = []
+                          , Contract.publicKeys           = []
+                          , Contract.tokens               = []
+                          }
+
+testDeleteContract :: UUID.UUID -> IO ()
+testDeleteContract uuid = do
+    status <- Db.deleteContractByUUID uuid
+    putStrLn $ "Deleted? " ++ show status
+
+testFindContractByUUID :: UUID.UUID -> IO ()
+testFindContractByUUID uuid = do
+    contract <- Db.findContractByUUID uuid
+    print contract
+
+
+
+
+
+
+
+
+
+
+
 
diff --git a/server-common/server-common.cabal b/server-common/server-common.cabal
index 210ab3b..d4b371e 100644
--- a/server-common/server-common.cabal
+++ b/server-common/server-common.cabal
@@ -17,6 +17,7 @@ cabal-version:       >=1.10
 
 library
   exposed-modules:
+    Db,
     Model.Challenge,
     Model.Contract,
     Model.Credential,
@@ -37,6 +38,7 @@ library
 
     aeson,
     base64-bytestring,
+    couchdb-conduit,
     crypto-pubkey,
     data-default,
     http-types,
@@ -46,7 +48,8 @@ library
     snap-extras == 0.7,
     text,
     uuid,
-    time
+    time,
+    transformers
 
   hs-source-dirs:      src
   default-language:    Haskell2010
diff --git a/server-common/src/Db.hs b/server-common/src/Db.hs
new file mode 100644
index 0000000..a1f9387
--- /dev/null
+++ b/server-common/src/Db.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Db where
+
+import           Control.Applicative
+import           Control.Monad.IO.Class            (MonadIO, liftIO)
+import           Control.Monad
+import           Data.Aeson 
+import qualified Data.ByteString.Char8 as C
+import           Database.CouchDB.Conduit
+import           Database.CouchDB.Conduit.Explicit
+
+import qualified Model.Contract as Contract
+import qualified Model.UUID as UUID
+
+dbName :: C.ByteString
+dbName = "contracts"
+
+conn :: CouchConnection
+conn = def
+
+-- TODO: Catch exceptions.
+findContractByUUID :: UUID.UUID -> IO Contract.Contract
+findContractByUUID uuid = runCouch conn $ do
+    (_, contract) <- couchGet dbName (UUID.toByteString' uuid) []
+    return contract
+
+newtype DocId = DocId C.ByteString
+    deriving (Eq, Show)
+
+instance FromJSON DocId where
+    parseJSON (Object v) =
+        DocId <$> v .: "id"
+
+data AllDocs = AllDocs [DocId]
+    deriving (Eq, Show)
+
+instance FromJSON AllDocs where
+    parseJSON (Object v) =
+        AllDocs <$> v .: "rows"
+
+selectAllContracts :: IO [Contract.Contract]
+selectAllContracts = do
+    contract <- findContractByUUID "b3ea803d-d16f-47d8-89fa-61dac3795487"
+    return [contract]
+
+createContract :: Contract.Contract -> IO Contract.Contract
+createContract contract = do
+    uuid <- liftIO $ UUID.nextRandom 
+    updateContract contract { Contract.uuid = uuid
+                            , Contract.revision = "" }
+
+updateContract :: Contract.Contract -> IO Contract.Contract
+updateContract contract = runCouch conn $ do
+    let uuid = UUID.toByteString' $ Contract.uuid contract
+        rev  = Contract.revision contract
+    revision <- couchPut dbName uuid rev [] contract
+    return contract { Contract.revision = revision }
+
+deleteContractByUUID :: UUID.UUID -> IO Bool
+deleteContractByUUID uuid = runCouch conn $ do
+    contract <- liftIO $ findContractByUUID uuid
+    couchDelete dbName (UUID.toByteString' uuid) (Contract.revision contract)
+    return True
+
diff --git a/server-common/src/Model/Contract.hs b/server-common/src/Model/Contract.hs
index f06d36d..99bbdf9 100644
--- a/server-common/src/Model/Contract.hs
+++ b/server-common/src/Model/Contract.hs
@@ -5,6 +5,7 @@ module Model.Contract where
 import           Control.Applicative
 import           Control.Monad
 import           Data.Aeson
+import           Data.ByteString           (ByteString)
 import           Data.Text                 (Text)
 import           Data.Time                 (UTCTime)
 
@@ -17,7 +18,8 @@ import           Model.Token
 import           Model.UUID
 
 data Contract = Contract {
-              uuid                 :: UUID,
+              uuid                 :: UUID,       -- CouchDB's.
+              revision             :: ByteString, -- CouchDB's.
               name                 :: Text,
               description          :: Text,
               creationDate         :: UTCTime,
@@ -32,7 +34,8 @@ data Contract = Contract {
               
 instance FromJSON Contract where
     parseJSON (Object v) =
-        Contract <$> v .: "uuid"
+        Contract <$> v .: "_id"  -- CouchDB's.
+                 <*> v .: "_rev" -- CouchDB's.
                  <*> v .: "name"
                  <*> v .: "description"
                  <*> v .: "creationDate"
@@ -46,9 +49,8 @@ instance FromJSON Contract where
     parseJSON _ = mzero
 
 instance ToJSON Contract where
-    toJSON (Contract c n d cd u s cr cc ca p t) =
-        object [ "uuid"                 .= c
-               , "name"                 .= n
+    toJSON (Contract _ _ n d cd u s cr cc ca p t) =
+        object [ "name"                 .= n
                , "description"          .= d
                , "creationDate"         .= cd
                , "users"                .= u
diff --git a/server-common/src/Model/UUID.hs b/server-common/src/Model/UUID.hs
index 90980f1..c705c4f 100644
--- a/server-common/src/Model/UUID.hs
+++ b/server-common/src/Model/UUID.hs
@@ -1,15 +1,17 @@
-{-# LANGUAGE DeriveGeneric #-} 
-{-# LANGUAGE OverloadedStrings #-} 
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Model.UUID where
 
-import           Control.Applicative ((<$>))
+import           Control.Applicative        ((<$>))
 import           Data.Aeson
-import           Data.Maybe (fromMaybe)
+import           Data.ByteString.Char8      as C (ByteString)
+import           Data.ByteString.Lazy.Char8 as CL (ByteString)
+import           Data.Maybe                 (fromMaybe)
 import           Data.String
-import           Data.Text as T (pack, unpack)
-import qualified Data.UUID (UUID, fromString, toString, nil, null)
-import qualified Data.UUID.V4 (nextRandom)
+import           Data.Text                  as T (pack, unpack)
+import qualified Data.UUID
+import qualified Data.UUID.V4               (nextRandom)
 import           GHC.Generics
 
 newtype UUID = UUID Data.UUID.UUID
@@ -31,6 +33,12 @@ fromStringSafe s = UUID <$> Data.UUID.fromString s
 toString :: UUID -> String
 toString (UUID u) = Data.UUID.toString u
 
+toByteString :: UUID -> CL.ByteString
+toByteString (UUID u) = Data.UUID.toLazyASCIIBytes u
+
+toByteString' :: UUID -> C.ByteString
+toByteString' (UUID u) = Data.UUID.toASCIIBytes u
+
 nextRandom :: IO UUID
 nextRandom = UUID <$> Data.UUID.V4.nextRandom