git.iko.soy/typeable/random-token
on master help sign in
swap
6cb8a608 ahead, 0 behind
random-token.cabal+106−98
since splitsnapshots
unifiedsplit
@@ -1,103 +1,111 @@
1−cabal-version: 2.4
1+cabal-version: 2.4
2−name: random-token
2+name: random-token
3−version: 0.1.0.0
3+version: 0.1.0.0
4−synopsis: Implementation of random token generation and parsing
4+synopsis: Implementation of random token generation and parsing
5−author: typeable.io
5+author: typeable.io
6−maintainer: s9gf4ult@gmail.com
6+maintainer: s9gf4ult@gmail.com
7−license-file: LICENSE
7+license-file: LICENSE
8−category: Web
8+category: Web
9−build-type: Simple
9+build-type: Simple
10
10
11library
11library
12− hs-source-dirs: src
12+ hs-source-dirs: src
13− ghc-options: -Wall
13+ ghc-options: -Wall
14− exposed-modules: Random.Token
14+ exposed-modules: Random.Token
15− build-depends: base >= 4.7 && < 5
15+ build-depends:
16− , QuickCheck
16+ , aeson
17− , aeson
17+ , base >=4.9 && <5
18− , base64-bytestring
18+ , base64-bytestring
19− , bytestring
19+ , bytestring >=0.10
20− , deepseq
20+ , deepseq
21− , http-api-data
21+ , http-api-data
22+ , QuickCheck
22− , text
23+ , text
24+
25+ if !(impl(ghcjs) || arch(javascript) || arch(wasm32))
26+ build-depends:
23− , cryptonite
27+ , cryptonite
24− , postgresql-simple
28+ , postgresql-simple
29+
25− default-language: Haskell2010
30+ default-language: Haskell2010
26− default-extensions: CPP
31+ default-extensions:
32+ CPP
27− , ConstraintKinds
33+ ConstraintKinds
28− , DataKinds
34+ DataKinds
29− , DeriveFoldable
35+ DeriveFoldable
30− , DeriveFunctor
36+ DeriveFunctor
31− , DeriveGeneric
37+ DeriveGeneric
32− , DeriveTraversable
38+ DeriveTraversable
33− , DuplicateRecordFields
39+ DuplicateRecordFields
34− , FlexibleContexts
40+ FlexibleContexts
35− , FlexibleInstances
41+ FlexibleInstances
36− , FunctionalDependencies
42+ FunctionalDependencies
37− , GADTs
43+ GADTs
38− , GeneralizedNewtypeDeriving
44+ GeneralizedNewtypeDeriving
39− , LambdaCase
45+ LambdaCase
40− , MultiParamTypeClasses
46+ MultiParamTypeClasses
41− , MultiWayIf
47+ MultiWayIf
42− , NumDecimals
48+ NumDecimals
43− , OverloadedStrings
49+ OverloadedStrings
44− , PolyKinds
50+ PolyKinds
45− , QuasiQuotes
51+ QuasiQuotes
46− , RankNTypes
52+ RankNTypes
47− , RecordWildCards
53+ RecordWildCards
48− , RoleAnnotations
54+ RoleAnnotations
49− , ScopedTypeVariables
55+ ScopedTypeVariables
50− , StandaloneDeriving
56+ StandaloneDeriving
51− , TemplateHaskell
57+ TemplateHaskell
52− , TupleSections
58+ TupleSections
53− , TypeApplications
59+ TypeApplications
54− , TypeFamilies
60+ TypeFamilies
55− , TypeOperators
61+ TypeOperators
56− , UndecidableInstances
62+ UndecidableInstances
57− , ViewPatterns
63+ ViewPatterns
58
64
59test-suite spec
65test-suite spec
60− type: exitcode-stdio-1.0
66+ type: exitcode-stdio-1.0
61− hs-source-dirs: spec
67+ hs-source-dirs: spec
62− main-is: Test.hs
68+ main-is: Test.hs
63− other-modules: TokenSpec
69+ other-modules: TokenSpec
64− default-language: Haskell2010
70+ default-language: Haskell2010
65− build-depends: base >= 4.10 && <4.13
71+ build-depends:
72+ , base >=4.10 && <5
66− , hspec
73+ , hspec
67− , random-token
74+ , random-token
75+
68 build-tool-depends: hspec-discover:hspec-discover
76 build-tool-depends: hspec-discover:hspec-discover
69− ghc-options: -Wall
77+ ghc-options:
70− -threaded
71− -rtsopts
72− "-with-rtsopts=-N -A64m -qb0 -n4m -T -I1"
78+ -Wall -threaded -rtsopts "-with-rtsopts=-N -A64m -qb0 -n4m -T -I1"
79+
73− ghc-prof-options: -fprof-auto
80+ ghc-prof-options: -fprof-auto
74− default-extensions: ConstraintKinds
81+ default-extensions:
82+ ConstraintKinds
75− , DataKinds
83+ DataKinds
76− , DeriveFoldable
84+ DeriveFoldable
77− , DeriveFunctor
85+ DeriveFunctor
78− , DeriveGeneric
86+ DeriveGeneric
79− , DeriveTraversable
87+ DeriveTraversable
80− , DuplicateRecordFields
88+ DuplicateRecordFields
81− , FlexibleContexts
89+ FlexibleContexts
82− , FlexibleInstances
90+ FlexibleInstances
83− , FunctionalDependencies
91+ FunctionalDependencies
84− , GADTs
92+ GADTs
85− , GeneralizedNewtypeDeriving
93+ GeneralizedNewtypeDeriving
86− , LambdaCase
94+ LambdaCase
87− , MultiParamTypeClasses
95+ MultiParamTypeClasses
88− , MultiWayIf
96+ MultiWayIf
89− , NumDecimals
97+ NumDecimals
90− , OverloadedStrings
98+ OverloadedStrings
91− , PolyKinds
99+ PolyKinds
92− , QuasiQuotes
100+ QuasiQuotes
93− , RankNTypes
101+ RankNTypes
94− , RecordWildCards
102+ RecordWildCards
95− , ScopedTypeVariables
103+ ScopedTypeVariables
96− , StandaloneDeriving
104+ StandaloneDeriving
97− , TemplateHaskell
105+ TemplateHaskell
98− , TupleSections
106+ TupleSections
99− , TypeApplications
107+ TypeApplications
100− , TypeFamilies
108+ TypeFamilies
101− , TypeOperators
109+ TypeOperators
102− , UndecidableInstances
110+ UndecidableInstances
103− , ViewPatterns
111+ ViewPatterns
src/Random/Token.hs+17
@@ -1,10 +1,15 @@
1+{-# LANGUAGE CPP #-}
1module Random.Token
2module Random.Token
2 ( Token
3 ( Token
3 , tokenToAscii
4 , tokenToAscii
4 , tokenToText
5 , tokenToText
5 , asciiToToken
6 , asciiToToken
6 , textToToken
7 , textToToken
8+ , unsafeCoerceToken
9+ , tokenWithContents
10+#ifndef ghcjs_HOST_OS
7 , generateToken
11 , generateToken
12+#endif
8 ) where
13 ) where
9
14
10import Control.DeepSeq
15import Control.DeepSeq
@@ -19,9 +24,12 @@ import Data.Typeable
19import Test.QuickCheck.Arbitrary
24import Test.QuickCheck.Arbitrary
20import Web.HttpApiData
25import Web.HttpApiData
21
26
27+
28+#ifndef ghcjs_HOST_OS
22import Crypto.Random as R
29import Crypto.Random as R
23import Database.PostgreSQL.Simple.FromField
30import Database.PostgreSQL.Simple.FromField
24import Database.PostgreSQL.Simple.ToField
31import Database.PostgreSQL.Simple.ToField
32+#endif
25
33
26-- | 16 bytes lenght random value parametrized by label.
34-- | 16 bytes lenght random value parametrized by label.
27newtype Token (a :: k) = Token ByteString
35newtype Token (a :: k) = Token ByteString
@@ -38,6 +46,7 @@ instance FromJSON (Token a) where
38instance ToJSON (Token a) where
46instance ToJSON (Token a) where
39 toJSON = toJSON . tokenToText
47 toJSON = toJSON . tokenToText
40
48
49+#ifndef ghcjs_HOST_OS
41instance forall a. (Typeable (Token a), Typeable a) => FromField (Token a) where
50instance forall a. (Typeable (Token a), Typeable a) => FromField (Token a) where
42 fromField fld bs = do
51 fromField fld bs = do
43 t <- fromField fld bs
52 t <- fromField fld bs
@@ -51,6 +60,8 @@ instance ToField (Token a) where
51generateToken :: (MonadRandom m) => m (Token a)
60generateToken :: (MonadRandom m) => m (Token a)
52generateToken = Token <$> R.getRandomBytes 16
61generateToken = Token <$> R.getRandomBytes 16
53
62
63+#endif
64+
54instance FromHttpApiData (Token a) where
65instance FromHttpApiData (Token a) where
55 parseQueryParam = first T.pack . textToToken
66 parseQueryParam = first T.pack . textToToken
56
67
@@ -68,3 +79,9 @@ asciiToToken bs = Token <$> B64.decode bs
68
79
69textToToken :: Text -> Either String (Token a)
80textToToken :: Text -> Either String (Token a)
70textToToken = asciiToToken . T.encodeUtf8
81textToToken = asciiToToken . T.encodeUtf8
82+
83+tokenWithContents :: Text -> Token a
84+tokenWithContents = Token . T.encodeUtf8
85+
86+unsafeCoerceToken :: Token a -> Token b
87+unsafeCoerceToken (Token a) = Token a