Is there a way to use the low level mongoDB backend from persistent-mongoDB? - haskell

In the SQL version of persistent it appears that direct access to SQL is done with rawSql. Is there a similar way to access low level commands from the mongoDB backend?

It turns out to be much easier than I thought. Just import Database.MongoDB and use the raw driver commands inside runDB. Example:
import Database.MongoDB
...
postCommentR :: DocumentId -> Handler Value
postCommentR documentId = do
comment <- commentOr400
let idString = toPathPiece documentId
contents = commentBody comment
runDB $ DB.modify (DB.select ["_id" DB.=: idString] "Document") ["$push" DB.=: ["comments" DB.=: contents]]
returnJson $ object []

Related

Haskell Unicode column name in ODBC

I am trying to query some data from a MSSQL database through HDBC and ODBC. I have however run into a problem when trying to query data from a table with unicode in the column names.
Consider the following MWE:
mwe :: IConnection conn => conn -> IO [[SqlValue]]
mwe conn =
do r <- quickQuery' conn
"SELECT [Højde] FROM [Table]"
[]
return r
When executing the above and passing it a connection object to the database i get the following error message:
*** Exception: SqlError {seState = "[\"42S22\",\"42000\"]", seNativeError = -1, seErrorMsg = "execute execute: [\"207: [Microsoft][ODBC Driver 17 for SQL Server][SQL Server]Invalid column name 'H\\195\\184jde'.\",\"8180: [Microsoft][ODBC Driver 17 for SQL Server][SQL Server]Statement(s) could not be prepared.\"]"}
The relevant part most likely being that H\\195\\184jde is not a valid column name.
My research has mostly led to results about unicode in the parameters to the query. I have tried to use bytestrings instead of normal strings, but since the argument for QuickQuery' is a string that did not help.
I don't have an MS SQL instance to test this, but the code in HDBC-odbc encodes the query using UTF-8. Meanwhile, this documentation suggests that for modern ODBC drivers, the character set used for queries depends on the process locale at the time the driver is initialized. If it's "C", which is the usual process default, then the driver will use the UTF-8 character set. However, if the process executes:
setlocale(LC_ALL,"")
before initializing the driver, and the current Windows locale is, say, English using the Latin-1 1252 code page, then the ODBC driver will expect Latin-1 encoded queries. Unfortunately for you, the GHC runtime does run setlocale(LC_ALL,""), so that's probably what's going wrong.
If you reset the locale to "C" at the start of "main", that may fix the issue:
{-# LANGUAGE ForeignFunctionInterface #-}
import Control.Monad
import Foreign.C
import Foreign.Ptr
foreign import ccall "locale.h setlocale" c_setlocale :: CInt -> CString -> IO CString
setCLocale :: IO ()
setCLocale = do
rc <- withCString "C" $ c_setlocale 0
when (rc == nullPtr) $ error "setCLocale failed"
main = do
setCLocale
print "whatever"
I'm not sure if this will cause other problems (e.g., with terminal input/output). If it does, you may be able to set the locale to "C" before initializing the driver and then reset it to "" right after.

Yesod book example chat and scaffolding

I'm trying to make the chat example from the Yesod book working in the scaffolding site.
I think I've corrected almost all I had to correct, but all of that is completely new to me (it's my first "real" Haskell project) and I'm not very confident in all my modifications; moreover, I'm really stuck at the point 7. Could you comment all the following points if necessary, and helping me for the 7. (in bold some questions/remarks)?
Copy/paste the Chat.hs and Chat/Data.hs in the root of my site,
add import Chat as Import and import Chat.Data as Import to Import.NoFoundation,
add import of IO, Bool, return, Maybe(Nothing), ($) in Data.hs, since the extension NoImplicitPrelude is on Seems very clumsy... Do we have to import all the standard operators on each new file?
in Fundation.hs, add getChat in the App record (after appHttpManager and appLogger)
in Fundation.hs, add YesodChat instance for App: I had to modify the getUserName on the Just uid case (in the original example of Chat, it was just Just uid -> return uid):
Just uid -> do
muser <- runDB $ get uid
case muser of
Nothing -> error "uid not in the DB"
Just user -> return $ userIdent user
This seems very long and nested... Can we do better?
In Fundation.hs, add chatWidget ChatR after the line pc <- widgetToPageContent $ do in the defaultLayout definition.
Now, I have the following warning :
Application.hs:60:36: Warning:
Fields of ‘App’ not initialised: getChat
In the expression: App {..}
I think I have to write something like getChat <- newChan >>=Chat after the appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger and appStatic <- ... in the makeFundation definition, but the type doesn't match. I'm a totally lost here, I don't really understand how this function makeFundation works.
You actually got almost the entire way there. I think you just need to change the line to:
getChat <- fmap Chat newChan
Alternatively, if you're not familiar with he fmap function yet, you can use do notation and get:
chan <- newChan
let getChat = Chat chan

Accepting specific certificate with http-client-tls or tls?

I'm probably just overlooking something basic in the documentation of http-client-tls and tls, but: how can I establish an HTTPS connection to a server and only accept one particular certificate, specified by me, that is potentially not in the system certificate store?
I see that this is an old question, but I just spent some time writing code to do this and figured I'd post it here for posterity... and in the hopes of getting some code review from the community. Snoyman's comment is helpful, but there are so many code interdependencies here, and X.509 and TLS are so boil the ocean, that it's hard to debug and to know for sure that you're not screwing something up without digging pretty deep into the various libraries. I figured a more complete explanation with working code was in order.
Anyways, here's what I've come up with (this is a stack script so you can run it easily yourself) --
#!/usr/bin/env stack
{- stack --resolver lts-7.16 runghc -}
import qualified Data.ByteString as B
import Data.ByteString.Lazy (ByteString)
import Data.Default.Class (def)
import Data.String (fromString)
import Data.X509.CertificateStore (CertificateStore, readCertificateStore)
import Network.HTTP.Client (httpLbs, newManager, ManagerSettings)
import Network.HTTP.Client.TLS (mkManagerSettings)
import Network.Connection (TLSSettings(TLSSettings))
import qualified Network.TLS as TLS
import qualified Network.TLS.Extra.Cipher as TLS
import System.Environment (getArgs, getProgName)
managerSettings :: CertificateStore -> ManagerSettings
managerSettings store = mkManagerSettings settings Nothing
where settings = TLSSettings params
params = (TLS.defaultParamsClient "" B.empty) {
TLS.clientUseServerNameIndication = True
, TLS.clientShared = def {
TLS.sharedCAStore = store
}
, TLS.clientSupported = def {
TLS.supportedCiphers = TLS.ciphersuite_default
}
}
get :: FilePath -> String -> IO ()
get ca url = do
mstore <- readCertificateStore ca
case mstore of
Just store -> do
manager <- newManager $ managerSettings store
response <- httpLbs (fromString url) manager
putStrLn (show response)
Nothing -> do
putStrLn $ "error: invalid certificate store " ++ ca
main :: IO ()
main = do
args <- getArgs
case args of
ca:url:[] -> get ca url
_ -> do
name <- getProgName
putStrLn $ "usage: " ++ name ++ " ca url"
A couple notes:
The TLS.sharedCAStore settings is where the magic happens. If you want to add your CA to the system store (vs. using only your CA) you can load the system store using getSystemCertificateStore from System.X509, then use Data.X509.CertificateStore to convert back and forth between CertificateStore and [SignedCertificate] to create a store with the system certificates along with your own.
TLS.defaultParamsClient takes a hostname and server id, used for TLS server name indication (SNI), a TLS extension that allows a server to host multiple sites on a single IP (similar to how HTTP/1.1 host headers work). We don't necessarily know what to set this to when we're creating a manager. Fortunately, Network.Connection (used by http-client-tls) appears to override whatever settings we use, so it doesn't matter.
The default for TLS.supportedCiphers is an empty list, so this setting is required (unless you turn off validation or something). Network.Connection defaults to ciphersuite_all but that includes some "not recommended last resource cipher suites" so I opted to use ciphersuite_default instead.
I think you're looking for ClientHooks. You can create a TLSSettings value with that by using the TLSSettings constructor, and then create a ManagerSettings using mkManagerSettings.

how can I do multi update with $ symbol in mongo engine

how can I do multi update with $ symbol with mongo engine in .py file, give any small example.
Refer to Atomic Updates in the docs:
Foo.objects.all().update(set__bar='baz')
>>> data = dict(set__real_rate=1, set__rate=1, set__change=1, set__variance=1, set__tags=[], set__cloud={}, set__description='not much')
>>> Grid.objects(id='tv').update(upsert=True, **data)
1
Theres examples in the test suite for mongoengine:
https://github.com/MongoEngine/mongoengine/blob/master/tests/queryset.py#L313-382
A quick example:
class BlogPost(Document):
title = StringField()
tags = ListField()
BlogPost.drop_collection()
BlogPost(title="ABC", tags=['mongoEngien']).save()
BlogPost.objects(tags="mongoEngien").update(set__tags__S="MongoEngine")

Basic example of using HaskellDB to unmap records of a table

Suppose that I have the following (PostgreSQL) table definition:
CREATE TABLE books (
id serial NOT NULL,
title character varying NOT NULL,
PRIMARY KEY (id)
);
And the following record definition:
data Book =
{ id :: Int
, title :: String
}
What is a basic example of an "unmap" function to query all books in the database, allBooks :: Database -> IO [Book]?
It turns out that I was going about this the wrong way.
After stumbling upon Mats Rauhala's exceedingly helpful blog post titled Example on using HaskellDB, I was able to write a test project to read the records of the books table.
I first needed to define the "layout", which, using haskelldb-th, is not too bad:
{-# LANGUAGE TemplateHaskell #-}
module Tables.Books (
books
, id
, title
, Books
) where
import Database.HaskellDB.CodeGen
import Prelude hiding (id)
mkDBDirectTable "Books" [
("id", [t|Int|])
, ("title", [t|String|])
]
From there, the allBooks function is:
allBooks db = query db $ do
books <- table B.books
return books
where B is the qualified name of imported module Tables.Books. allBooks has the type:
allBooks :: Database
-> IO
[Record
(Database.HaskellDB.HDBRec.RecCons
Tables.Books.Id
Int
(Database.HaskellDB.HDBRec.RecCons
Tables.Books.Title
String
Database.HaskellDB.HDBRec.RecNil))]
To print out each title, I used:
main :: IO ()
main = do
books <- postgresqlConnect [("host", "localhost"), ("user", "test"), ("password", "********")] allBooks
mapM_ putStrLn (map (\r -> r!B.title) books)
return ()
EDIT: I created a git repository containing the complete sources of this example: dtrebbien/haskelldb-example

Resources