Skip to content
GitLab
Explore
Projects
Groups
Topics
Snippets
Projects
Groups
Topics
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Marcus Mängel
KeyInfo
Commits
3f4ce3f2
Commit
3f4ce3f2
authored
6 years ago
by
Andreas Boysen
Committed by
Benny Baumann
6 years ago
Browse files
Options
Downloads
Patches
Plain Diff
addet get by id for CryptoKeyMeta and CrytoKoyAttributes WARNING: This commit is untestet
parent
6b42f9e8
Branches
newDB
No related merge requests found
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
KeyInfoService/KeyInfoService.cabal
+19
-2
KeyInfoService/KeyInfoService.cabal
KeyInfoService/src/DBConstructor.hs
+46
-4
KeyInfoService/src/DBConstructor.hs
KeyInfoService/src/DBTypes.hs
+32
-18
KeyInfoService/src/DBTypes.hs
KeyInfoService/src/DBapi.hs
+13
-7
KeyInfoService/src/DBapi.hs
with
110 additions
and
31 deletions
KeyInfoService/KeyInfoService.cabal
+
19
−
2
View file @
3f4ce3f2
...
...
@@ -18,7 +18,23 @@ cabal-version: >=1.10
executable KeyInfoService
main-is: kishttp.hs
-- other-modules:
other-modules: Control.Monad.ERIO,
Control.Monad.ERIO.IO,
CryptoKey,
DB.Hasql.Connection.ERIO,
DB.Hasql.Decoders.ERIO,
DB.Hasql.Encoders.ERIO,
DB.Hasql.Query.ERIO,
DB.Hasql.Session.ERIO,
DBConfig,
DBConstructor,
DBTypes,
DBapi,
KeyDB,
ParseWeb,
Parser.ASN1,
Parser.KeyData,
Parser.Parser
-- other-extensions:
build-depends:
base >=4.8,
...
...
@@ -50,7 +66,8 @@ executable KeyInfoService
postgresql-libpq,
contravariant,
profunctors,
vector
vector,
convertible
hs-source-dirs: src
default-language: Haskell2010
...
...
This diff is collapsed.
Click to expand it.
KeyInfoService/src/DBConstructor.hs
+
46
−
4
View file @
3f4ce3f2
...
...
@@ -54,15 +54,29 @@ withTestConn = HC.acquire credentials
-- GetBy functionen
class
GetByI
D
a
where
getByI
D
::
Query
(
I
D
a
)
(
Maybe
a
)
class
GetByI
d
a
where
getByI
d
::
Query
(
I
d
a
)
(
Maybe
a
)
instance
GetByI
D
CryptoKey
where
getByI
D
=
HQ
.
statement
q1s
q1p
qr_CryptoKey
True
instance
GetByI
d
CryptoKey
where
getByI
d
=
HQ
.
statement
q1s
q1p
qr_CryptoKey
True
where
q1s
=
"SELECT * FROM crypto_key WHERE id = $1"
q1p
=
contramap
getID
(
HE
.
value
HE
.
int8
)
instance
GetById
CryptoKeyAttributes
where
getById
=
HQ
.
statement
q1s
q1p
qr_CryptoKeyAttribute
True
where
q1s
=
"SELECT * FROM crypto_key_attributes WHERE id = $1"
q1p
=
contramap
getID
(
HE
.
value
HE
.
int8
)
instance
GetById
CryptoKeyMeta
where
getById
=
HQ
.
statement
q1s
q1p
qr_CryptoKeyMeta
True
where
q1s
=
"SELECT * FROM crypto_key_Meta WHERE id = $1"
q1p
=
contramap
getID
(
HE
.
value
HE
.
int8
)
-- Result Parser
-- crypto_key
qr_CryptoKey
=
HD
.
maybeRow
$
CryptoKey
<$>
HD
.
value
HD
.
int8
<*>
...
...
@@ -95,6 +109,34 @@ qr_CryptoKeys =
HD
.
value
HD
.
bytea
<*>
HD
.
nullableValue
HD
.
bytea
-- CryptoKeyAttributes
qr_CryptoKeyAttribute_h
=
CryptoKeyAttributes
<$>
HD
.
value
HD
.
int8
<*>
HD
.
value
(
fmap
(
Left
.
Id
)
HD
.
int8
)
<*>
HD
.
value
HD
.
text
<*>
HD
.
value
HD
.
int8
<*>
HD
.
value
HD
.
bytea
qr_CryptoKeyAttribute
=
HD
.
maybeRow
qr_CryptoKeyAttribute_h
qr_CryptoKeyAttributes
=
HD
.
rowsVector
qr_CryptoKeyAttribute_h
-- CryptoKeyMeta
qr_CryptoKeyMeta_h
=
CryptoKeyMeta
<$>
HD
.
value
HD
.
int8
<*>
HD
.
value
(
fmap
(
Left
.
Id
)
HD
.
int8
)
<*>
HD
.
value
HD
.
text
<*>
HD
.
value
HD
.
int8
<*>
HD
.
value
HD
.
bytea
qr_CryptoKeyMeta
=
HD
.
maybeRow
qr_CryptoKeyMeta_h
qr_CryptoKeyMetas
=
HD
.
rowsVector
qr_CryptoKeyMeta_h
-- Request
getBySearch
::
(
SearchRequest
,
Int
,
Int
)
->
Query
(
SearchRequest
,
Int
,
Int
)
(
Vector
CryptoKey
)
...
...
This diff is collapsed.
Click to expand it.
KeyInfoService/src/DBTypes.hs
+
32
−
18
View file @
3f4ce3f2
{-# LANGUAGE FlexibleContexts#-}
module
DBTypes
where
import
Data.ByteString
import
Data.Int
import
Data.Text
import
Data.Convertible.Instances.Num
import
Data.Convertible
-- State of the row ::
data
I
D
a
=
I
D
{
getID
::
Int64
}
data
I
d
a
=
I
d
{
getID
::
Int64
}
deriving
(
Show
,
Read
)
newId
::
Convertible
n
Int64
=>
n
->
Id
a
newId
n
=
Id
{
getID
=
convert
n
}
-- example usage : ((newId 42):: Id CryptoKey )
-- class FromRaw a b where
-- genFromRaw :: a -> [b]
...
...
@@ -41,36 +49,42 @@ data NewCryptoKey = NewCryptoKey {
deriving
Show
data
CryptoKeyAttributes
=
CryptoKeyAttributesByID
Int64
|
CryptoKeyAttributesRaw
{
CryptoKeyAttributes
{
cka_id
::
Int64
,
cka_key
::
CryptoKey
,
cka_name
::
ByteString
,
cka_key
::
Either
(
Id
CryptoKey
)
CryptoKey
,
cka_name
::
Text
,
cka_order
::
Int64
,
cka_value
::
ByteString
}
|
CryptoKeyAttributesNew
{
new_cka_key
::
CryptoKey
,
new_cka_name
::
ByteString
,
}
deriving
Show
data
NewCryptoKeyAttributes
=
NewCryptoKeyAttributes
{
new_cka_key
::
Either
(
Id
CryptoKey
)
CryptoKey
,
new_cka_name
::
Text
,
new_cka_order
::
Int32
,
new_cka_value
::
ByteString
}
deriving
Show
data
CryptoKeyMeta
=
CryptoKeyMetaByID
Int64
|
CryptoKeyMetasRaw
{
CryptoKeyMeta
{
ckm_id
::
Int64
,
ckm_key
::
CryptoKey
,
ckm_name
::
ByteString
,
ckm_key
::
Either
(
Id
CryptoKey
)
CryptoKey
,
ckm_name
::
Text
,
ckm_order
::
Int64
,
ckm_value
::
ByteString
}
|
CryptoKeyMetaNew
{
new_ckm_key
::
CryptoKey
,
new_ckm_name
::
ByteString
,
}
deriving
Show
data
NewCryptoKeyMeta
=
NewCryptoKeyMeta
{
new_ckm_key
::
Either
(
Id
CryptoKey
)
CryptoKey
,
new_ckm_name
::
Text
,
new_ckm_order
::
Int32
,
new_ckm_value
::
ByteString
}
deriving
Show
-- Fingerprint types and Smart Constructors
...
...
This diff is collapsed.
Click to expand it.
KeyInfoService/src/DBapi.hs
+
13
−
7
View file @
3f4ce3f2
...
...
@@ -36,14 +36,20 @@ search r sn nn = do
(
Left
e
)
->
error
$
"Something went wrong (2)"
++
show
e
(
Right
erg
)
->
return
erg
-- tests
testSearch
::
IO
()
testSearch
=
do
e
<-
search
(
Not
(
FV_id
7
))
0
100
print
e
byHash
::
ByteString
->
IO
[
CryptoKey
]
byHash
s
=
do
res
<-
liftIO
$
search
(
Is
$
FV_sha3_512
s
)
0
1024
return
$
toList
res
-- count variante aller anfragen.
byId
::
GetById
a
=>
Id
a
->
IO
(
Maybe
a
)
byId
ident
=
do
-- ERIO stack iniizialisiren
(
_
,
e
)
<-
evalERIO'
Nil
$
do
withTestConn
$
do
HS
.
run
$
HS
.
query
ident
(
getById
)
case
e
of
(
Left
e
)
->
error
"Something went wrong (1)"
(
Right
er
)
->
case
er
of
(
Left
e
)
->
error
$
"Something went wrong (2)"
++
show
e
(
Right
erg
)
->
return
erg
This diff is collapsed.
Click to expand it.
Preview
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment
Menu
Explore
Projects
Groups
Topics
Snippets