Welcome, guest! Login / Register - Why register?
Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)

Paste

Pasted as Haskell by lleksah15 ( 11 years ago )
type a :|- b = a :> Header "Auth-Token" Text :> b
infixr 8 :|-

type API = 
         "users" :> (ReqBody '[JSON] User) :|- (Post '[JSON] Int64)
    :<|> "user"  :> (Capture "id" UserId) :|- (Get '[JSON] FrontEndUser)


type AppM = ReaderT Config (EitherT ServantErr IO)

userAPI :: Proxy API
userAPI = Proxy

app :: Config -> Application
app cfg = serve userAPI (readerServer cfg)

readerServer :: Config -> Server API
readerServer cfg = enter (readerToEither cfg) server

readerToEither :: Config -> AppM :~> EitherT ServantErr IO
readerToEither cfg = Nat $ \x -> runReaderT x cfg

server :: ServerT API AppM
server = createPerson :<|> singlePerson 

 data Fr User 

instance ToJSON FrontEndUser where 
    toJSON (FrontEndUser User{..}) = object ["name" .= userName]


instance FromText (Key User) where
  fromText = fmap toSqlKey . fromText

singlePerson :: Maybe Text -> UserId -> AppM FrontEndUser
singlePerson uid = do
    muser <- runDb $ get $ toSqlKey 1
    case muser of
        Just u -> return (FrontEndUser u)
        Nothing -> lift $ left err404 { errBody = "User not found" }

createPerson :: Maybe Text -> User -> AppM Int64
createPerson mauth u = do
    newPerson <- runDb $ insert u
    return $ fromSqlKey newPerson

 

Revise this Paste

Parent: 78988
Your Name: Code Language: