nuttycom/aftok - Change PBD7LZYQHXAA3KLH2ZUX5GW4UFML6BQ32KXZF4KZ6OYFASUYFJ5QC

Postgres & auth are beginning to function.

Created by Kris Nuttycombe on February 15, 2015

PBD7LZYQHXAA3KLH2ZUX5GW4UFML6BQ32KXZF4KZ6OYFASUYFJ5QC

Dependencies

In channels

main

Change contents

Insertion in .gitignore at line 12 [4.135]
[3.29]
```
local
stable
snaplets
regtest.conf
site_key.txt
```

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 152 [5.456]

B:BD[5.4341] → [5.4341:4444]

    "INSERT INTO bids (auction_id, user_id, bid_seconds, bid_amount, bid_time) values (?, ?, ?, ?, ?)"

[5.4341]

[5.4444]

    "INSERT INTO bids (auction_id, bidder_id, bid_seconds, bid_amount, bid_time) values (?, ?, ?, ?, ?)"

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 172 [5.456]

B:BD[5.4978] → [5.4978:5055]

    "INSERT INTO users (handle, btc_addr, email) VALUES (?, ?) RETURNING id"

[5.4978]

[6.339]

    "INSERT INTO users (handle, btc_addr, email) VALUES (?, ?, ?) RETURNING id"

File addition: Util (d--x------)
[7.18]

File addition: Http.hs (----------)

[0.242]

module Quixotic.Util.Http where
import ClassyPrelude 
import Data.ByteString (split)
import Data.Attoparsec.ByteString 
import qualified Data.ByteString.Base64 as B64
type AuthHeader = (Text, ByteString)
authHeaderParser :: Parser AuthHeader
authHeaderParser = do
  let isBase64Char w = (w >= 47 && w <= 57 ) ||
                       (w >= 64 && w <= 90 ) ||
                       (w >= 97 && w <= 122) ||
                       (w == 43 || w == 61 )
  b64     <- string "Basic " *> takeWhile1 isBase64Char 
  decoded <- either fail pure $ B64.decode b64
  case split 58 decoded of
    (uname : pwd : []) -> pure $ (decodeUtf8 uname, pwd)
    _ -> fail "Could not unpack auth header into username and password components"

Replacement in lib/Quixotic.hs at line 40 [9.2457]
B:BD[8.3223] → [8.3223:3251]
```
  { _projectId :: ProjectId
```
[8.3223]
[8.3251]
```
  { _invitationProject :: ProjectId
```

Insertion in quixotic.cabal at line 30 [10.1]

[10.751]

[11.1584]

                      Quixotic.Util.Http

Insertion in quixotic.cabal at line 35 [10.1]
[11.1742]
[3.3072]
```
    , attoparsec           >= 0.12.1.2
```
Insertion in quixotic.cabal at line 37 [10.1]
[3.3089]
[11.1780]
```
    , bytestring
```
Insertion in quixotic.cabal at line 53 [10.1]
[12.1084]
[13.1070]
```
    , base64-bytestring    >= 1.0.0.1
```
Insertion in quixotic.cabal at line 71 [10.1]
[11.2171]
[3.3112]
```
    , attoparsec
```
File addition: scripts (d--x------)
[14.2]

File addition: create_project.sh (---x------)

[0.1220]

#!/bin/bash
curl -v -u "nuttycom:kjntest" -H "Content-Type: application/json" -d '{"projectName":"the"}' http://localhost:8000/projects

File addition: create_user.sh (---x------)

[0.1220]

#!/bin/bash
curl -v -H "Content-Type: application/json" -d '{"username":"nuttycom", "password":"kjntest", "email":"kris@quixoticcompany.com", "btcAddr":"1KamUn1BaRMd2HwikyQWGTdUvfPScg9QA5"}' http://localhost:8000/register

Insertion in server/Main.hs at line 17 [4.5188]
[2.117]
[15.782]
```
import Quixotic.Snaplet.Projects
```

Replacement in server/Main.hs at line 52 [4.5188]

∅:D[16.106] → [15.823:867]

∅:D[2.179] → [15.823:867]

B:BD[15.823] → [15.823:867]

            , ("register", registerHandler)

[2.179]

[8.3639]

            , ("register", method POST registerHandler)
            , ("projects", projectsHandler)

Replacement in server/Main.hs at line 57 [4.5188]

B:BD[8.3862] → [8.3862:3957]

            , ("projects/:projectId", ok)
            , ("payouts/:projectId", payoutsHandler)

[8.3862]

[5.8999]

            , ("projects/:projectId", method GET ok)
            , ("payouts/:projectId", method GET payoutsHandler)

Replacement in server/Quixotic/Snaplet/Auth.hs at line 7 [2.203]

B:BD[2.310] → [2.310:423]

import Data.ByteString (split)
import Data.Attoparsec.ByteString 
import qualified Data.ByteString.Base64 as B64

[2.310]

[2.423]

import Data.Attoparsec.ByteString (parseOnly)

Insertion in server/Quixotic/Snaplet/Auth.hs at line 11 [2.203]
[2.465]
[2.465]
```
import Quixotic.Util.Http (authHeaderParser)
```
Deletion in server/Quixotic/Snaplet/Auth.hs at line 18 [2.203]
B:BD[2.605] → [2.605:643]
```
type AuthHeader = (Text, ByteString)
```

Deletion in server/Quixotic/Snaplet/Auth.hs at line 19 [2.203]

B:BD[2.644] → [2.644:1164]

authHeaderParser :: Parser AuthHeader
authHeaderParser = do
  let isBase64Char w = (w >= 47 && w <= 57 ) ||
                       (w >= 64 && w <= 90 ) ||
                       (w >= 97 && w <= 122) ||
                       (w == 43 || w == 61 )
  b64     <- string "Basic" *> takeWhile1 isBase64Char 
  decoded <- either fail pure $ B64.decode b64
  case split 58 decoded of
    (uname : pwd : []) -> pure $ (decodeUtf8 uname, pwd)
    _ -> fail "Could not unpack auth header into username and password components"

Insertion in server/Quixotic/Snaplet/Auth.hs at line 23 [2.203]
[2.1323]
[2.1323]
```
  logError rawHeader
```
Insertion in server/Quixotic/Snaplet/Auth.hs at line 46 [2.203]
[2.2252]
[2.2252]
```
  QDB{..} <- view qdb <$> with qm get
```

Replacement in server/Quixotic/Snaplet/Auth.hs at line 50 [2.203]

B:BD[2.2445] → [2.2445:2558]

    Just pid -> error $ "FIXME: implement project access check - got pid " ++ " " ++ show uid ++ " " ++ show pid

[2.2445]

[2.2558]

    Just pid -> do
      projects <- liftPG . runReaderT $ findUserProjects uid
      if any (\p -> p ^. projectId == pid) projects
        then pure pid
        else snapError 403 $ "User " ++ (tshow uid) ++ " does not have access to project " ++ (tshow pid)

File addition: Projects.hs (----------)

[2.182]

{-# LANGUAGE TemplateHaskell #-}
module Quixotic.Snaplet.Projects 
  ( projectsHandler
  ) where
import ClassyPrelude 
import Control.Lens
import Control.Monad.State
import Data.Aeson as A
import Quixotic
import Quixotic.Database
import Quixotic.Snaplet
import Quixotic.Snaplet.Auth
import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.PostgresqlSimple
data CreateProject = CreateProject { createProjectName :: Text }
instance FromJSON CreateProject where
  parseJSON (Object v) = CreateProject <$> v .: "projectName"
  parseJSON _ = mzero
projectsHandler :: Handler App App ()
projectsHandler = do
  void $ method POST projectCreateHandler
  void $ method GET projectListHandler
projectCreateHandler :: Handler App App ProjectId
projectCreateHandler = do
  QDB{..} <- view qdb <$> with qm get
  uid <- requireUserId
  requestBody <- readRequestBody 4096
  cp <- maybe (snapError 400 "Could not parse project data") pure $ A.decode requestBody
  timestamp <- liftIO getCurrentTime
  liftPG . runReaderT . createProject $ Project (createProjectName cp) timestamp uid
projectListHandler :: Handler App App [Project]
projectListHandler = ok

Replacement in server/Quixotic/Snaplet/Users.hs at line 39 [15.3234]
B:BD[17.716] → [17.716:751]
```
  requestBody <- readRequestBody 0
```
[17.716]
[17.751]
```
  requestBody <- readRequestBody 4096
```

Replacement in server/Quixotic/Snaplet/Users.hs at line 41 [15.3234]

B:BD[17.843] → [17.843:1025]

  authUser <- with auth $ 
    AU.createUser (userData ^. (cuser.username._UserName)) (userData ^. password)
  let createQUser = liftPG $ runReaderT (createUser $ userData ^. cuser)

[17.843]

[17.1025]

  let createSUser = AU.createUser (userData ^. (cuser.username._UserName)) (userData ^. password)
      createQUser = liftPG $ runReaderT (createUser $ userData ^. cuser)
  authUser <- with auth createSUser

Replacement in server/Quixotic/Snaplet.hs at line 51 [15.1088]
B:BD[15.3096] → [15.3096:3122]
```
ok :: MonadSnap m => m ()
```
[15.3096]
[15.3122]
```
ok :: MonadSnap m => m a
```
Insertion in server/Quixotic/Snaplet.hs at line 56 [15.1088]
[2.3904]

Replacement in sql/quixotic-pg.sql at line 2 [9.3144]

B:BD[9.3166] → [9.3166:3201]

  btc_addr varchar(34) primary key

[9.3166]

[9.3201]

  id serial primary key,
  handle text not null,
  btc_addr text not null,
  email text not null  
);
create table projects (
  id serial primary key,
  project_name text not null,
  inception_date timestamp without time zone not null,
  initiator_id integer references users (id) not null

Replacement in sql/quixotic-pg.sql at line 15 [9.3144]

B:BD[9.3205] → [9.3205:3234]

create table users_trusted (

[9.3205]

[9.3234]

create type event_t as enum ('start_work', 'stop_work');
create table work_events (

Replacement in sql/quixotic-pg.sql at line 19 [9.3144]

B:BD[9.3259] → [9.3259:3357]

  btc_addr varchar(34) references users (btc_addr) not null,
  trust_interval interval not null
)

[9.3259]

[9.3357]

  project_id integer references projects(id) not null,
  user_id integer references users(id) not null,
  btc_addr text not null,
  event_type event_t not null,
  event_time timestamp without time zone not null
);

Replacement in sql/quixotic-pg.sql at line 26 [9.3144]

B:BD[9.3358] → [9.3358:3418]

create type event_type as enum ('start_work', 'stop_work');

[9.3358]

[9.3418]

create table auctions (
  id serial primary key,
  project_id integer references projects(id) not null,
  initiator_id integer references users (id) not null,
  raise_amount numeric not null,
  end_time timestamp without time zone not null
);

Replacement in sql/quixotic-pg.sql at line 34 [9.3144]
B:BD[9.3419] → [9.3419:3442]
```
create table timelog (
```
[9.3419]
[9.3442]
```
create table bids (
```

Replacement in sql/quixotic-pg.sql at line 36 [9.3144]

B:BD[9.3467] → [9.3467:3610]

  btc_addr varchar(34) references users (btc_addr) not null,
  log_time timestamp without time zone not null,
  log_type event_type not null
)

[9.3467]

  auction_id integer references projects (id) not null,
  bidder_id integer references users (id) not null,
  bid_seconds integer not null,
  bid_amount numeric not null,
  bid_time timestamp without time zone not null
);

File addition: Util (d--x------)
[3.3700]

File addition: HttpSpec.hs (----------)

[0.4914]

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, NoImplicitPrelude #-}
module Quixotic.Util.HttpSpec where
import ClassyPrelude
import Quixotic.Util.Http
import Data.Attoparsec.ByteString 
import Test.Hspec
spec :: Spec
spec = do
  describe "HTTP Basic header parsing" $ do
    it "parses the Basic auth header" $ do
      let rawHeader = "Basic bnV0dHljb206a2pudGVzdA=="
      (parseOnly authHeaderParser rawHeader) `shouldBe` (Right ("nuttycom", "kjntest"))
main :: IO ()
main = hspec spec

Postgres & auth are beginning to function.

Dependencies

In channels

Change contents

Insertion in .gitignore at line 12 [4.135]

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 152 [5.456]

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 172 [5.456]

File addition: Util (d--x------)

File addition: Http.hs (----------)

Replacement in lib/Quixotic.hs at line 40 [9.2457]

Insertion in quixotic.cabal at line 30 [10.1]

Insertion in quixotic.cabal at line 35 [10.1]

Insertion in quixotic.cabal at line 37 [10.1]

Insertion in quixotic.cabal at line 53 [10.1]

Insertion in quixotic.cabal at line 71 [10.1]

File addition: scripts (d--x------)

File addition: create_project.sh (---x------)

File addition: create_user.sh (---x------)

Insertion in server/Main.hs at line 17 [4.5188]

Replacement in server/Main.hs at line 52 [4.5188]

Replacement in server/Main.hs at line 57 [4.5188]

Replacement in server/Quixotic/Snaplet/Auth.hs at line 7 [2.203]

Insertion in server/Quixotic/Snaplet/Auth.hs at line 11 [2.203]

Deletion in server/Quixotic/Snaplet/Auth.hs at line 18 [2.203]

Deletion in server/Quixotic/Snaplet/Auth.hs at line 19 [2.203]

Insertion in server/Quixotic/Snaplet/Auth.hs at line 23 [2.203]

Insertion in server/Quixotic/Snaplet/Auth.hs at line 46 [2.203]